用vba实现二元矩阵的两两比较

我有一个这样的二进制矩阵（但有200多行100列）

我必须在以下条件下对每一行进行两两比较，如果两个单元格都有1，则结果为1，如果两个单元格都有0或1和0，则结果为0

这样就产生了一个新的矩阵

AB= 1 0 0

BC= 0 0 1

AC= 0 0 0

---

由于我有一个巨大的矩阵，在vba中有没有一个简单的方法来实现这一点？

好的。我已经像这样设置了我的电子表格1

用下面的代码

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

---

---

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

可以通过循环完成。我不理解这种逻辑。你能做得更好吗explain@mehow这就像按位比较，如果两个单元格都是1，那么只有1？如果它们都是0呢？在数学逻辑中，0和0将是1如果您将n行相互比较，您将得到n*（n-1）/2个结果行。对于n=200+来说，这相当多，或者仅仅比较相邻行就足够了吗？很好！“r1和r2”的含义是什么？@AxelKemper the

只是£sub的名称。

>r1和r2

调用sub，将一个参数传递给它-连接的r1和r2成为一个字符串（变体），即字母组合。

子菜单将所有可能的行组合打印到

表2中。如果不向下滚动，则无法看到“£”。我不知道这样的名字是允许的。有很多技巧人们都不知道：P我主要使用write a
sub作为
debug.print
的包装。我宁愿只键入带有一个参数或参数数组的
，而不是键入
debug.print
。
的实现取决于问题的复杂性/code工作是否完美。谢谢
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