使用vba进行二元矩阵的成对比较

Question

我有一个像这样的二进制矩阵（但有超过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中有一种简单的方法吗？

Answer 1

确定。我已经设置了电子表格 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 中构建一个矩阵，它最终会像这样

---

请注意，您可以添加更多行和更多列，这仍然适用于您。