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返回尺寸为2到D的数组（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 s的公共区域：

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

Answer 4

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

Answer 5

这里有一些代码可以执行两个向量范围。您可以针对两行，两列运行它。

不要认为它与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

Answer 6

= EXACT（B2; D2）公式并向下拖动，对我来说是最佳选择。

Answer 7

为了完整起见，我会在这里提出一个大锤到破解的答案，因为问题是这两个范围是否相同？＆＃39;正在成为其他人的一个未经审查的组成部分比较我的范围然后做这个复杂的事情......＆＃39; 问题。

您的问题是一个关于小范围的简单问题。我的回答是针对大的;但问题是一个好问题，也是一个更通用答案的好地方，因为它简单明了：＆＃39;这些范围是否不同？＆＃39; 和＆＃39;有人篡改了我的数据吗？＆＃39; 与大多数商业Excel用户相关。

典型的大部分答案都比较了我的行＆＃39;问题是VBA中的逐个单元读取和比较。这些答案的简单性值得称道，但这种方法对大型数据集的执行速度非常慢，因为：

一次读取一个单元格的范围非常慢;
逐个比较值是低效的，特别是对于字符串，当值的数量达到数万时，

var = Range("A1")

var = Range("A1:Z1024")

...与工作表的每次交互所花费的时间是VBA中字符串比较的四倍，比浮点小数之间的比较长二十倍;反过来，它比整数比较长三倍。

因此，如果您一次性读取整个范围，并且在VBA中处理Range.Value2数组，那么您的代码可能会快四倍，并且可能快一百倍。

Office 2010和2013中的那些（我对它们进行了测试）;对于旧版本的Excel，您可以看到每秒VBA与单元格的交互，或者在1/50 ^th和1/500 ^th之间的引用时间。细胞范围。这将是方式更慢，因为在新旧版本的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将使运行时减半。

您的下一个挑战只有在您从大范围内获取数以万计的价值时才有意义：在此扩展答案中，如果小于此值，则无法获得任何性能提升。

我们正在做的是：

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

这个想法非常简单，虽然基础数学对于非数学家来说是相当具有挑战性的：我们不是一次比较一个值，而是运行一个数学函数，即哈希＆＃39;这些值成为一个简短的标识符，便于比较。

如果您反复比较范围与参考＆＃39;复制，你可以存储＆＃39;参考＆＃39;哈希，这使工作量减半。

有一些快速可靠的散列函数，它们在Windows中作为安全和加密API的一部分提供。它们运行在字符串上有一个小问题，我们有一个数组可以工作;但你可以很容易地找到一个快速的“Join2D”＃39;从范围的.Value2属性返回的2D数组中获取字符串的函数。

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

Public Function RangeCompare(Range1 as Excel.Range, Range2 As Excel.Range) AS Boolean
' Returns TRUE if the ranges are identical.
' This function is case-sensitive.
' For ranges with fewer than ~1000 cells, cell-by-cell comparison is faster

' WARNING: This function will fail if your range contains error values.

RangeCompare = False

If Range1.Cells.Count <> Range2.Cells.Count Then
    RangeCompare = False
ElseIf Range1.Cells.Count = 1 then
    RangeCompare = Range1.Value2 = Range2.Value2
Else
    RangeCompare = MD5(Join2D(Range1.Value2)) = MD5(Join2D(Range2.Value2))
Endif

End Function

我在此VBA函数中包装了Windows System.Security MD5哈希：

Public Function MD5(arrBytes() As Byte) As String
' Return an MD5 hash for any string

' Author: Nigel Heffernan Excellerando.Blogspot.com

' Note the type pun: you can pass in a string, there's no type conversion or cast
' because a string is stored as a Byte array and VBA recognises this.

    oMD5 As Object  'Set a reference to mscorlib 4.0 to use early binding


    Dim HashBytes() As Byte
    Dim i As Integer


    Set oMD5 = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
    HashBytes = oMD5.ComputeHash_2((arrBytes))
 
    For i = LBound(HashBytes) To UBound(HashBytes)
        MD5 = MD5 & Right("00" & Hex(HashBytes(i)), 2)
    Next i


   Set oMD5 = Nothing ' if you're doing this repeatedly, declare at module level and persist
   Erase HashBytes


End Function

等价

相同

2015年快速而简单的Join2D功能为posted by Dick Kusleika on Daily Dose of Excel：

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

如果您需要在进行比较之前删除空行，则需要Join2D function I posted in StackOverflow back in 2012。

这种类型的哈希比较最常见的应用是电子表格控制 - 更改监控 - 并且您会看到Range1.Formula使用而不是Range1.Value2：但是你的问题是关于比较价值，而不是公式。

脚注：我已将a very similar answer张贴在其他位置。如果我早些时候看过这个问题，我先在这里发布。

Answer 8

Excel 2016有一个名为TEXTJOIN

的内置函数

keras.utils.Sequence

看看@Tim Williams回答并使用这个新函数（没有65536行限制）：

Sub checkit()
    MsgBox WorksheetFunction.TextJoin(Chr(0), False, ActiveSheet.Rows(1).Value) = _
           WorksheetFunction.TextJoin(Chr(0), False, ActiveSheet.Rows(2).Value)
End Sub

写成函数：

Public Function CheckRangeValsEqual(ByVal r1 As Range, ByVal r2 As Range, Optional ByVal strJoinOn As String = vbNullString) As Boolean
    CheckRangeValsEqual = WorksheetFunction.TextJoin(strJoinOn, False, r1.Value) = _
                          WorksheetFunction.TextJoin(strJoinOn, False, r2.Value)
End Function

Answer 9

如果要在 MS excel 中执行此操作，则可以执行以下操作。

例如，您具有从“ A” 到“ F” 的每一行的列范围，并且必须在第2行和第3行。要检查整行并将其与另一行进行比较，我们可以在公式中的新 Result 列中进行指定，而不是在键入公式后按 Enter ，而是按 Ctrl + Shift + Enter 。

=AND(EXACT(A2:F2,A3:F3))

如果匹配，结果将为 TRUE ，如果不匹配，则结果为 FALSE 。如果已正确将其输入为数组公式，则会在公式周围看到花括号。之后，向下拖动每一行，以使该 Result列的每个单元格在该行与下一行之间具有比较结果！

Answer 10

我知道这里已经有答案了，但是这里有一个简单的仅VBA的函数，它比较任意两个范围内的值，如果匹配则返回TRUE，否则返回第一个不匹配的项目号。（如果范围没有相同数量的单元格，则返回FALSE。）

Function RangesEqualItemNo(Range1 As Range, Range2 As Range) As Variant

    Dim CellCount As Long

    If Range1.Count = Range2.Count Then

        For CellCount = 1 To Range1.Cells.Count
            If Range1.Cells.item(CellCount).Value <> Range2.Cells.item(CellCount).Value Then
                RangesEqualItemNo = CellCount
                Exit Function
            End If
        Next CellCount

        RangesEqualItemNo = True

    Else
        RangesEqualItemNo = False

    End If

End Function

或作为简单的布尔函数：

Function RangesEqual(Range1 As Range, Range2 As Range) As Boolean

    Dim CellCount As Long

    If Range1.Count = Range2.Count Then

        For CellCount = 1 To Range1.Cells.Count
            If Range1.Cells.item(CellCount).Value <> Range2.Cells.item(CellCount).Value Then
                RangesEqual = False
                Exit Function
            End If
        Next CellCount

        RangesEqual = True

    Else
        RangesEqual = False

    End If

End Function

尽管这可能并不理想，但这种暴力手段通常是最快的。

这将比较值，因此它将自动在列和行之间进行转置，而这可能是您想要的，也可能不是您想要的。

要将其转到逻辑上的下一步，以下函数将返回每个项目编号不同的数组。

Function RangeDiffItems(Range1 As Range, Range2 As Range, Optional DiffSizes As Boolean = False) As Long()

    Dim CellCount As Long
    Dim DiffItems() As Long
    Dim DiffCount As Long

    ReDim DiffItems(1 To Range1.Count)

    DiffCount = 0

    If Range1.Count = Range2.Count Or DiffSizes Then

        For CellCount = 1 To Range1.Cells.Count
            If Range1.Cells.item(CellCount).Value <> Range2.Cells.item(CellCount).Value Then
                DiffCount = DiffCount + 1
                DiffItems(DiffCount) = CellCount
            End If
        Next CellCount

        If DiffCount = 0 Then DiffItems(1) = 0

    Else
        DiffItems(1) = -1
    End If

    If DiffCount = 0 Then ReDim Preserve DiffItems(1 To 1) Else ReDim Preserve DiffItems(1 To DiffCount)

    RangeDiffItems = DiffItems

End Function

如果没有差异，则它在第一个阵列插槽中返回0，或者如果阵列的大小不同，则其对第一个阵列点返回-1。要允许它比较不同大小的数组，可以选择在第三个参数中输入TRUE。

这个问题在其他地方也有a few more answers。

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

10 个答案:

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