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

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

score 33 · Accepted Answer

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()数组会给我们一个字符串，其中原始单元格值由“空字符”( Chr(0)) 分隔：我们选择它是因为它不太可能出现在任何单元格值本身中。
在此之后，我们现在有两个很容易比较的常规字符串

注意：正如 Reafidy 在评论中指出的那样，Transpose()不能处理超过大约的数组。65,000 个元素，因此您不能使用这种方法比较 Excel 版本中的两个整列，其中工作表的行数超过此数量（即任何非古代版本）。

注意 2：与从工作表读取的数据变量数组上使用的循环相比，此方法的性能非常差。 如果您要对大量行进行逐行比较，那么上述方法会慢得多。

score 13 · Accepted Answer

对于您的具体示例，这里有两种方法...

不区分大小写：

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

score 6 · Accepted Answer

好的，这应该相当快：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

score 2 · Accepted Answer

Excel 2016 有一个内置函数，称为TEXTJOIN

https://support.office.com/en-us/article/textjoin-function-357b449a-ec91-49d0-80c3-0e8fc845691c

查看@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

score 1 · Accepted Answer

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

score 1 · Accepted Answer

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

不要以为它和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

score 0 · Accepted Answer

0

=EXACT(B2;D2) 公式并向下拖动，对我来说是最好的选择。

于 2015-02-18T13:52:24.280 回答

score 0 · Accepted Answer

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

你的问题是一个关于小范围的简单问题。我的答案是大的；但这个问题是一个很好的问题，也是一个更一般性答案的好地方，因为它简单明了：“这些范围有什么不同吗？” 和“有人篡改了我的数据吗？” 与大多数商业 Excel 用户相关。

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

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

Point(1) 是重要的一点：VBA 拾取单个单元格所花费的时间与var = Range("A1")使用var = Range("A1:Z1024")...

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

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

那是在 Office 2010 和 2013 中（我测试过它们）；对于旧版本的 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将使运行时间减半。

仅当您从大范围中获取数万个值时，您的下一个挑战才有意义：对于任何小于此的扩展答案，都没有性能提升。

我们正在做的是：

使用哈希函数比较两个大范围的值

这个想法非常简单，尽管基础数学对于非数学家来说非常具有挑战性：我们不是一次比较一个值，而是运行一个数学函数，将这些值“散列”成一个简短的标识符，以便于比较。

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

那里有一些快速可靠的散列函数，它们在 Windows 中作为安全和加密 API 的一部分提供。有一个小问题是它们在字符串上运行，我们有一个数组要处理；但是您可以轻松找到一个快速的“Join2D”函数，该函数从范围.Value2属性返回的二维数组中获取字符串。

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

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

还有其他 VBA 实现，但似乎没有人知道 Byte Array / String 类型双关语——它们不等价，它们是相同的——所以每个人都编写了不必要的类型转换。

Dick Kusleika 于 2015 年在 Daily Dose of Excel 上发布了一个快速简单的 Join2D 函数：

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 函数。

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

脚注：我在其他地方发布了一个非常相似的答案。如果我早些时候看到这个问题，我会先在这里发布。

score 0 · Accepted Answer

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

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

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

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

score 0 · Accepted Answer

我知道这里已经有了答案，但这里有一个简单的 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

虽然这可能并不花哨，但这种蛮力方法通常是最快的。

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

为了将其带到合乎逻辑的下一步，以下函数将返回一个包含每个不同项目编号的数组。

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。

这个问题在其他地方也有更多的答案。

score -1 · Accepted Answer

在我的版本中，我没有声明任何东西（Dim）。这可能是错误的，但多年来我一直使用 Excel VBA - 大多数情况下它从未停止过代码的工作。在这种情况下，范围以区域的形式给出。如果不是，那么您应该使用 Dim Range1 作为 Range 等。在我的代码中，该区域必须是相同的，无论如何，相同的行和列。这是我认为最短的方法：

Set Range1 = Range("A1:B5")
Set Range2 = Range("D1:E5")
'Range1
For Each rng In Range1 'Selection
st1 = st1 & rng & ","
Next rng
'Range2
For Each rng In Range2 'Selection
st2 = st2 & rng & ","
Next rng
    'compare
    If st1 = st2 Then
        MsgBox "the same"
    Else
        MsgBox "different"
    End If

这个另一个例子有点长，它读取行和列并将其用于两个区域。如果您设置范围，则 range(1) 仍将是该范围内从顶部算起的第一个单元格。这是我的代码：

Sub COMPARE()
    Set Range1 = Range("A1:B5")
    Set Range2 = Range("D1:E5")
    'area
    coly = Range1.Columns.Count 'columns
    rowy = Range1.Rows.Count 'rows
    
    For i = 1 To coly
        For j = 1 To rowy
            st1 = st1 & Range1(i, j)
            st2 = st2 & Range2(i, j)
        Next j
    Next i
    'compare
    If st1 = st2 Then
        MsgBox "the same"
    Else
        MsgBox "different"
    End If
End Sub

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

11 回答 11

使用哈希函数比较两个大范围的值

Related

Reference