3

このようなバイナリ行列があります (ただし、200 行と 100 列を超えています)。

 A  1     0     0     
 B  1     1     1     
 C  0     0     1

次の条件で行ごとにペアワイズ比較を行う必要があります。両方のセルが 1 の場合、結果は 1 です。両方のセルが 0 または 1 と 0 の場合、結果は 0 です。

これにより、次のような新しいマトリックスが得られます。

AB= 1 0 0

BC= 0 0 1

AC= 0 0 0

私は巨大な行列を持っているので、vba でこれを行う簡単な方法はありますか?

4

1 に答える 1

0

Ok。このようにスプレッドシートSheet1を設定しました

ここに画像の説明を入力

以下のコードで

Option Explicit

Private nxt As Long

Sub Main()
    nxt = 1
    Dim i As Long, j As Long
    Dim r1 As Range, r2 As Range
    Sheet2.Cells.ClearContents
    For i = 1 To Sheet1.Range("A" & Rows.Count).End(xlUp).Row
        Set r1 = Sheet1.Range("A" & i)
        For j = i + 1 To Sheet1.Range("A" & Rows.Count).End(xlUp).Row
            Set r2 = Sheet1.Range("A" & j)
            £ r1 & r2
            CompareRows r1, r2
        Next j
    Next i

End Sub

Private Sub CompareRows(i As Range, j As Range)
    Dim c As Long
    For c = 1 To Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column - 1
        If (i.Offset(0, c) = 1) And (j.Offset(0, c) = 1) Then
            Sheet2.Cells(nxt, i.Offset(0, c).Column) = 1
        Else
            Sheet2.Cells(nxt, i.Offset(0, c).Column) = 0
        End If
    Next c
    nxt = nxt + 1
End Sub


Private Sub £(s)
    If Not IsEmpty(Sheet2.Range("A1")) Then
        Sheet2.Range("A" & Sheet2.Range("A" & Rows.Count).End(xlUp).Row + 1) = s
    Else
        Sheet2.Range("A1") = s
    End If
End Sub

コードはSheet2にマトリックスを作成し、最終的には次のようになります

ここに画像の説明を入力

行と列を追加できますが、これは引き続き機能します。

于 2013-10-04T07:51:09.993 に答える