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

我是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 
 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()只能用于一维数组,所以我们通过Application.Transpose()运行数组两次。 注意:如果您是比较列而不是行,那么您只需要通过Transpose()一次。
  • 对数组应用Join()给了我们一个单独的string,其中原始单元格值由“空字符”( Chr(0) )分隔:我们select它,因为它不可能存在于任何单元格值中。
  • 在此之后,我们现在有两个比较容易的常规string

注意:正如Reafidy在注释中指出的那样, Transpose()不能处理超过约数的数组。 65,000个元素,所以你不能使用这种方法来比较两个Excel版本中的表中有多于这个行数(即任何非古代版本)的整个列。

注2:与从工作表中读取数据的variables数组所使用的循环相比,此方法的性能相当差。 如果你打算对大量的行进行逐行比较,那么上面的方法会慢很多。

对于你的具体例子,这里有两种方法…

不区分大小写:

 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 

好的,这应该是相当快的: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 
 Match = True Row1length = Worksheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column Row2length = Worksheets("Sheet2").Cells(1, Columns.Count).End(xlToLeft).Column If Row1length <> Row2length Then 'Not equal Match = False Else For i = 1 To Row1length If Worksheets("Sheet1").Cells(1, i),Value <> Worksheets("Sheet2").Cells(1, i) Then Match = False Exit For End If Next End If If Match = True Then Debug.Print "match" Else Debug.Print "not match" End If 

这里有一些代码可以做两个向量范围。 你可以运行它两行,两列。

不要认为它和x2转置方法一样快,但它更灵活。 因为有1M个项目可以比较,所以列调用需要更长的时间!

 Option Explicit Public Sub Test() 'Check two columns Debug.Print DataAreasAreSame(Columns("a"), Columns("b")) 'Check two rows Debug.Print DataAreasAreSame(Rows(1), Rows(2)) End Sub Public Function DataAreasAreSame(ByVal DataArea1 As Range, ByVal DataArea2 As Range) As Boolean Dim sFormula As String sFormula = "=SUM(If(EXACT(" & DataArea1.Address & "," & DataArea2.Address & ")=TRUE,0,1))" If Application.Evaluate(sFormula) = 0 Then DataAreasAreSame = True End Function 

=精确(B2; D2)公式并拖下来,对我来说是最好的select。

为了完整起见,我会在这里填上一个大锤到破解坚果的答案,因为问题是“这两个范围是否相同? 作为所有人的未来范围的比较,然后做这个复杂的事情…”的未经检验的组成部分。

你的问题是一个关于小范围的简单问题。 我的答案是大的; 但这个问题是一个很好的问题,也是一个更一般的答案的好地方,因为它简单明了: “这些范围是不一样的吗?“有人篡改我的数据? 与大多数商业Excel用户相关。

大多数典型的“比较我的行”问题的答案是在VBA中逐个单元的读取和比较。 这些答案的简单性是值得赞扬的,但这种方法在大型数据集上执行得非常慢,因为:

  1. 一次读取一个单元格的范围非常缓慢;
  2. 比较成对的值是无效的,特别是对于string,当值的数量达到成千上万时,

要点(1)非常重要:VBA使用var = Range("A1")来获取单个单元格的时间与使用var = Range("A1:Z1024")

…与VBA中的每一次交互都比VBA中的string比较时间多四倍,比浮点小数之间的比较长二十倍; 而这又是一个整数比较的三倍。

因此,如果您一次读取整个范围,并且使用VBA中的Range.Value2数组,则您的代码可能会快四倍,而且速度可能会快一百倍。

这是在Office 2010和2013(我testing了他们); 对于较早版本的Excel,对于与单元格或单元格区域的每个VBA交互,您将看到1/50到1/500秒之间的引用时间。 这样会变慢,因为在Excel的新版本和新版本中,VBA动作仍然是单位数字的微秒数:如果你的代码运行速度会快上百倍,而且可能会快上千倍您可以避免在早期版本的Excel中从工作表读取单元格。

 arr1 = Range1.Values arr2 = Range2.Values 
' Consider checking that the two ranges are the same size ' And definitely check that they aren't single-cell ranges, ' which return a scalar variable, not an array, from .Value2
' WARNING: THIS CODE WILL FAIL IF YOUR RANGE CONTAINS AN ERROR VALUE
For i = LBound(arr1, 1) To Ubound(arr1, 2)
For j = LBound(arr1, 2) To Ubound(arr1, 2)
If arr1(i, j) <> arr2(i, j) Then bMatchFail = True Exit For End If
Next j
If bMatchFail Then Exit For
Next i
Erase arr1 Erase arr2

您会注意到,这个代码示例是通用的,即使是从单独的工作簿中,也可以从任意位置获取两个相同大小的范围。 如果你正在比较两个相邻的列,加载一个两列的数组,然后比较IF arrX(i, 1) <> arrX(i,2) Then将运行时间减半。

你的下一个挑战只有在你从大范围内获得数以万计的价值时才有意义:对于小于这个范围的任何东西,在这个扩展答案中没有性能增益。

我们正在做的是:

使用散列函数来比较两个大范围的值

这个想法非常简单,但是对于非math家来说,底层math是相当具有挑战性的:与其一次比较一个数值,我们运行一个math函数,将数值“哈希”成一个简短的标识符,以便于比较。

如果您反复地将范围与“参考”副本进行比较,则可以存储“参考”哈希值,这会将工作量减半。

这里有一些快速和可靠的哈希函数,它们在Windows中作为安全和encryptionAPI的一部分提供。 有一个小问题,就是它们在string上运行,我们有一个数组来处理; 但是您可以轻松find一个快速的“Join2D”函数,该函数从范围的.Value2属性返回的二维数组中获取一个string。

因此,两个大范围的快速比较函数将如下所示:

公共函数RangeCompare(Range1 as Excel.Range,Range2 As Excel.Range)AS布尔值
如果范围相同,则返回TRUE。
 '这个function是区分大小写的。
对于小于1000个细胞的范围,逐个细胞比较是更快的 
警告:如果您的范围包含错误值,则此function将失败。
RangeCompare = False
如果Range1.Cells.Count <> Range2.Cells.Count然后 RangeCompare = False 否则,如果Range1.Cells.Count = 1,那么 RangeCompare = Range1.Value2 = Range2.Value2 其他 RangeCompare = MD5(Join2D(Range1.Value2))= MD5(Join2D(Range2.Value2)) 万一
结束function

我在这个VBA函数中封装了Windows System.Security MD5哈希:

公共函数MD5(arrBytes()作为字节)作为string
 '返回任何string的MD5散列 
'作者:Nigel Heffernan Excellerando.Blogspot.com
'注意types双关:你可以传入一个string,没有types转换或转换 '因为一个string被存储为一个字节数组,VBA可以识别这个string。
oMD5 As Object'设置对mscorlib 4.0的引用以使用早期绑定

昏暗的HashBytes()作为字节 昏暗我作为整数

设置oMD5 = CreateObject(“System.Security.Cryptography.MD5CryptoServiceProvider”) HashBytes = oMD5.ComputeHash_2((arrBytes))
对于我= LBound(HashBytes)到UBound(HashBytes) MD5 = MD5&Right(“00”&Hex(HashBytes(i)),2) 接下来我

设置oMD5 = Nothing“,如果你反复这样做,在模块级声明并坚持 擦除HashBytes

结束function

还有其他的VBA实现,但似乎没有人知道字节数组/stringtypes的双关语 – 它们不是等同的 ,它们是相同的 – 所以每个人都编码不必要的types转换。

Dick Kusleika在2015年Excel的每日剂量上发布了一个快捷简单的Join2Dfunction:

 Public Function Join2D(ByVal vArray As Variant, Optional ByVal sWordDelim As String = " ", Optional ByVal sLineDelim As String = vbNewLine) As String Dim i As Long, j As Long Dim aReturn() As String Dim aLine() As String ReDim aReturn(LBound(vArray, 1) To UBound(vArray, 1)) ReDim aLine(LBound(vArray, 2) To UBound(vArray, 2)) For i = LBound(vArray, 1) To UBound(vArray, 1) For j = LBound(vArray, 2) To UBound(vArray, 2) 'Put the current line into a 1d array aLine(j) = vArray(i, j) Next j 'Join the current line into a 1d array aReturn(i) = Join(aLine, sWordDelim) Next i Join2D = Join(aReturn, sLineDelim) End Function 

如果您在进行比较之前需要删除空行,则需要在2012年发布在StackOverflow中的Join2D函数 。

这种types的散列比较最常见的应用是电子表格控制 – 更改监控 – 你会看到Range1.Formula而不是Range1.Value2 :但你的问题是关于比较值,而不是公式。

脚注:我在其他地方发表了非常类似的答案 。 如果我早一点看过这个问题的话,我会先把它发布在这里。