如何比较工作表中的两个整行

Question

我是VBA的新手.我手头有工作来提高VBA代码的性能.为了提高代码的性能,我必须读取整行并将其与另一行进行比较.在VBA中有什么办法吗？

伪代码:

sheet1_row1=read row1 from sheet1
sheet2_row1=read row1 from sheet2
if sheet1_row1 = sheet2_row1 then
      print "Row contains same value"
else
      print "Row contains diff value"
end if

Answer 1

Sub checkit()
Dim a As Application
Set a = Application
MsgBox Join(a.Transpose(a.Transpose(ActiveSheet.Rows(1).Value)), Chr(0)) = _
       Join(a.Transpose(a.Transpose(ActiveSheet.Rows(2).Value)), Chr(0))

End Sub

这是怎么回事:

• a只是Application为了使下面的代码更容易阅读的简写
• ActiveSheet.Rows(1).Value 返回带维度的二维数组(1到1,1到{工作表中的列数})
• 我们想将上面的数组压缩成单个值Join(),因此我们可以将它与第二行中的不同数组进行比较.但是,Join()仅适用于1-D数组,因此我们运行数组两次Application.Transpose().注意:如果您要比较列而不是行,那么您只需要通过Transpose()进行一次传递.
• 应用于Join()数组给我们一个字符串,其中原始单元格值由"空字符"(Chr(0))分隔:我们选择它,因为它不可能出现在任何单元格值本身中.
• 在此之后,我们现在有两个易于比较的常规字符串

注意:正如Reafidy在评论中指出的那样,Transpose()无法处理超过大约的数组.65,000个元素,因此您不能使用此方法来比较Excel中具有超过此行数(即任何非古代版本)的Excel版本中的两个完整列.

注意2:与从工作表读取的变量数据数组上使用的循环相比,此方法的性能非常差. 如果你要在大量行上进行逐行比较,那么上面的方法会慢得多.

Answer 2

对于您的具体示例,这里有两种方式......

不区分大小写:

MsgBox [and(1:1=2:2)]

区分大小写:

MsgBox [and(exact(1:1,2:2))]

...

以下是用于比较任何两个连续范围的通用函数.

不区分大小写:

Public Function RangesEqual(r1 As Range, r2 As Range) As Boolean
    RangesEqual = Evaluate("and(" & r1.Address & "=" & r2.Address & ")")
End Function

区分大小写:

Public Function RangesEqual(r1 As Range, r2 As Range) As Boolean
    RangesEqual = Evaluate("and(exact(" & r1.Address & "," & r2.Address & "))")
End Function

Answer 3

好吧,这应该是相当快的:Excel UI和VBA之间的最小交互(这是缓慢生活的地方).假设工作表具有类似的布局,$A$1并且我们只会尝试匹配UsedRange两个工作表的公共区域:

Public Sub CompareSheets(wks1 As Worksheet, wks2 As Worksheet)

Dim rowsToCompare As Long, colsToCompare As Long    
    rowsToCompare = CheckCount(wks1.UsedRange.Rows.Count, wks2.UsedRange.Rows.Count, "Row")
    colsToCompare = CheckCount(wks1.UsedRange.Columns.Count, wks2.UsedRange.Columns.Count, "Column")    
    CompareRows wks1, wks2, rowsToCompare, colsToCompare

End Sub

Private Function CheckCount(count1 As Long, count2 As Long, which As String) As Long
    If count1 <> count2 Then
        Debug.Print "UsedRange " & which & " counts differ: " _
            & count1 & " <> " & count2
    End If
    CheckCount = count2
    If count1 < count2 Then
        CheckCount = count1
    End If        
End Function

Private Sub CompareRows(wks1 As Worksheet, wks2 As Worksheet, rowCount As Long, colCount As Long)
    Debug.Print "Comparing first " & rowCount & " rows & " & colCount & " columns..."        
Dim arr1, arr2
    arr1 = wks1.Cells(1, 1).Resize(rowCount, colCount).Value
    arr2 = wks2.Cells(1, 1).Resize(rowCount, colCount).Value
Dim rIdx As Long, cIdx As Long    
    For rIdx = LBound(arr1, 1) To UBound(arr1, 1)
        For cIdx = LBound(arr1, 2) To UBound(arr1, 2)
            If arr1(rIdx, cIdx) <> arr2(rIdx, cIdx) Then
                Debug.Print "(" & rIdx & "," & cIdx & "): " & arr1(rIdx, cIdx) & " <> " & arr2(rIdx, cIdx)
            End If
        Next
    Next
End Sub