vba - 使用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中构建了一个矩阵，结果如下

---

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