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
How to compare two entire rows in a sheet
提问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:
这是怎么回事:
a
is just shorthand forApplication
to keep the code below easier to readActiveSheet.Rows(1).Value
returns 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 throughApplication.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$1
and that we're only going to attempt to match the common area of the UsedRange
s 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 中的逐个单元格读取和比较。这些答案的简单性值得称赞,但这种方法在大型数据集上的执行速度非常慢,因为:
- Reading a range one cell at a time is very slow;
- Comparing values pair-by-pair is inefficient, especially for strings, when the number of values gets into the tens of thousands,
- 一次读取一个单元格的范围非常慢;
- 逐对比较值是低效的,特别是对于字符串,当值的数量达到数万时,
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.Value2
array 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) Then
is 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 .Value2
property.
有一些快速可靠的散列函数,它们作为安全和加密 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.Formula
used instead of Range1.Value2
: but your question is about comparing values, not formulae.
这种类型的哈希比较最常见的应用是用于电子表格控制 -更改监控- 您会看到Range1.Formula
used 而不是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 2和Row 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.