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

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/19395633/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-08 16:56:27  来源:igfitidea点击:

How to compare two entire rows in a sheet

excelvbaexcel-vba

提问by Vicky

I am new to VBA. I have job in my hand to improve performance of VBA code. To improve performance of the code, I have to read entire row and compare it with another row. Is there any way to do this in VBA?

我是 VBA 的新手。我手头有工作来提高 VBA 代码的性能。为了提高代码的性能,我必须读取整行并将其与另一行进行比较。有没有办法在 VBA 中做到这一点?

Pseudocode:

伪代码:

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

回答by Tim Williams

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

What's going on:

这是怎么回事:

  • ais just shorthand for Applicationto keep the code below easier to read
  • ActiveSheet.Rows(1).Valuereturns a 2-D array with dimensions (1 to 1, 1 to {number of columns in a worksheet})
  • We'd like to condense the array above into a single value using Join(), so we can compare it with a different array from the second row. However, Join() only works on 1-D arrays, so we run the array twice through Application.Transpose(). Note: if you were comparing columns instead of rows then you'd only need one pass through Transpose().
  • Applying Join()to the array gives us a single string where the original cell values are separated by a "null character" (Chr(0)): we select this since it's unlikely to be present in any of the cell values themselves.
  • After this we now have two regular strings which are easily compared
  • a只是Application为了让下面的代码更易于阅读
  • ActiveSheet.Rows(1).Value返回具有维度(1 到 1,1 到 {工作表中的列数})的二维数组
  • 我们想使用 将上面的数组压缩为单个值Join(),以便我们可以将它与第二行的不同数组进行比较。但是,Join() 仅适用于一维数组,因此我们通过 运行该数组两次Application.Transpose()。注意:如果您比较的是列而不是行,那么您只需要一次通过 Transpose()。
  • 应用于Join()数组为我们提供了一个字符串,其中原始单元格值由“空字符” ( Chr(0))分隔:我们选择它是因为它不太可能出现在任何单元格值本身中。
  • 在此之后,我们现在有两个很容易比较的常规字符串

Note: as pointed out by Reafidy in the comments, Transpose()can't handle arrays with more than approx. 65,000 elements, so you can't use this approach to compare two whole columns in versions of Excel where sheets have more than this number of rows (i.e. any non-ancient version).

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

Note 2: this method has quite bad performance compared to a loop used on a variant array of data read from the worksheet.If you're going to do a row-by-row comparison over a large number of rows, then the approach above will be much slower.

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

回答by Excel Hero

For your specific example, here are two ways...

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

Case Insensitive:

不区分大小写:

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

Case Sensitive:

区分大小写:

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

...

...

Below are generalized functions to compare any two contiguous ranges.

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

Case Insensitive:

不区分大小写:

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

Case Sensitive:

区分大小写:

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

回答by Mike Woodhouse

OK, this ought to be fairly fast: minimal interaction between Excel UI and VBA (which is where much of the slowness lives). Assumes worksheets have similar layouts from $A$1and that we're only going to attempt to match the common area of the UsedRanges for the two sheets:

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

回答by Aye_Aye_Frey

Excel 2016 has a built in function called TEXTJOIN

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

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

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

Looking at @Tim Williams answer and using this new function (which does not have the 65536 row limit):

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

Written as a function:

写成函数:

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

回答by PaulG

Here's a bit of code that will do two vector ranges. You can run it against two rows, two columns.

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

Don't think it's as fast as the x2 transpose method, but it's more flexible. The column invocation takes a bit longer since there are 1M items to compare!

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

回答by chiliNUT

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

回答by q3kep

=EXACT(B2;D2) formula and drag down, best option for me.

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

回答by Nigel Heffernan

I'll put in a sledgehammer-to-crack-a-nut answer here, for completeness, because the question 'Are these two ranges identical?' is turning up as an unexamined component of everyone else's 'compare my ranges and then do this complicated thing...'questions.

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

Your question is a simple question about small ranges. My answer is for large ones; but the question is a good one, and a good place for a more general answer, because it's simple and clear: and 'Do these ranges differ?'and 'Has someone tampered with my data?'are relevant to most commercial Excel users.

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

Most of the answers to the typical 'compare my rows' questions are cell-by-cell reads and comparisons in VBA. The simplicity of these answers is commendable, but this approach performs very slowly on a large data sets because:

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

  1. Reading a range one cell at a time is very slow;
  2. Comparing values pair-by-pair is inefficient, especially for strings, when the number of values gets into the tens of thousands,
  1. 一次读取一个单元格的范围非常慢;
  2. 逐对比较值是低效的,特别是对于字符串,当值的数量达到数万时,
Point(1) 是重要的一点:VBA 使用一次拾取单个单元格所需的时间与一次性var = Range("A1")var = Range("A1")拾取整个范围所花费的时间相同var = Range("A1:Z1024")var = Range("A1:Z1024")...

...And every interaction with the sheet takes four times as much time as a string comparison in VBA, and twenty times longer than an comparison between floating-point decimals; and that, in turn, is three times longer than an integer comparison.

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

So your code will probably be four times faster, and possibly a hundred times faster, if you read the entire range in one go, and work on the Range.Value2array in VBA.

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

That's in Office 2010 and 2013 (I tested them); for older version of Excel, you'll see quoted times between 1/50thand 1/500thof a second, for each VBA interaction with a cell or range of cells. That'll be wayslower because, in both old and new versions of Excel, the VBA actions will still be in single-digit numbers of microseconds: your code will run at least a hundred times faster, and probably thousands of times faster, if you avoid cell-by-cell reads from the sheet in older versions of Excel.

那是在 Office 2010 和 2013 中(我测试过);老年人版本的Excel,你会看到引述1/50倍之间和1/500第二的,对于一个单元格或范围内的每个VBA互动。那将是这样慢,因为,在新老版本的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

You'll notice that this code sample is generic, for two ranges of the same size taken from anywhere - even from separate workbooks. If you're comparing two adjacent columns, loading a single array of two columns and comparing IF arrX(i, 1) <> arrX(i,2) Thenis going to halve the runtime.

您会注意到此代码示例是通用的,适用于从任何地方获取的两个相同大小的范围 - 甚至来自不同的工作簿。如果您要比较两个相邻的列,加载一个包含两列的数组并进行比较IF arrX(i, 1) <> arrX(i,2) Then将使运行时间减半。

Your next challenge is only relevant if you're picking up tens of thousands of values from large ranges: there's no performance gain in this extended answer for anything smaller than that.

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

What we're doing is:

我们正在做的是:

Using a hash function to compare the values of two large ranges

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

The idea is very simple, although the underlying mathematics is quite challenging for non-mathematicians: rather than comparing one value at a time, we run a mathematical function that 'hashes' the values into a short identifier for easy comparison.

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

If you're repeatedly comparing ranges against a 'reference' copy, you can store the 'reference' hash, and this halves the workload.

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

There are some fast and reliable hashing functions out there, and they are available in Windows as part of the security and cryptography API. There is a slight problem in that they run on strings, and we have an array to work on; but you can easily find a fast 'Join2D' function that gets a string from the 2D arrays returned by a range's .Value2property.

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

So a fast comparison function for two large ranges will look like this:

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

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

I've wrapped the Windows System.Security MD5 hash in this VBA 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 实现,但似乎没有人知道字节数组/字符串类型的双关语——它们不是 equivalent等价的,他们是identical相同- 所以每个人都编写了不必要的类型转换。

A fast and simple Join2D function was posted by Dick Kusleika on Daily Dose of Excelin 2015:

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

If you need to excise blank rows before you make the comparison, you'll need the Join2D function I posted in StackOverflow back in 2012.

如果您需要在进行比较之前去除空白行,您将需要我在 2012 年在 StackOverflow 中发布Join2D 函数

The most common application of this type of hash comparison is for spreadsheet control - change monitoring- and you'll see Range1.Formulaused instead of Range1.Value2: but your question is about comparing values, not formulae.

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

Footnote:I've posted a very similar answerelsewhere. I'd've posted it here first if I'd seen this question earlier.

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

回答by Nawshad Rehan Rasha

If you want to do this in MS excel, you can do the following.

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

For example, you have column range of each row from "A"to "F"and have to compare between Row 2and Row 3. To check entire row and compare it with another row we can specify this in formula in a new Resultcolumn and instead of pressing Enterafter typing the formula, press Ctrl+ Shift+ Enter.

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

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

The result will be TRUEif they match and FALSEif they don't. You'll see curly braces around your formula if you've correctly entered it as an array formula. After this, drag down every row so that each cell of this Result Columnwill have comparison result between this row and the following!

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

回答by sdanse

I know there are already answers here, but here is a simple VBA-only function that compares the values in any two ranges, returning TRUE if they match, or the first non-matching item number if they don't. (It returns FALSE if the ranges do not have the same number of cells.)

我知道这里已经有了答案,但这里有一个简单的 VBA-only 函数,它比较任意两个范围内的值,如果匹配则返回 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

Or as a simple boolean 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

Although this may not be fancy, this sort of brute-force approach is often the fastest.

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

This compares values, so it will automatically transpose between columns and rows, which may or may not be what you want.

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

To take this to the logical next step, the following function will return an array of each item number that is different.

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

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

If there are no differences, it returns a 0 in the first array slot, or if the arrays are of different sizes, it returns a -1 for the first array spot. To allow it to compare arrays of different sizes, optionally enter TRUE for the third parameter.

如果没有差异,它会在第一个数组槽中返回 0,或者如果数组的大小不同,它会在第一个数组位置返回 -1。要允许它比较不同大小的数组,可选择为第三个参数输入 TRUE。

There are also a few more answersto this question elsewhere.

在其他地方也有一些关于这个问题的答案