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
8 个解决方案
#1
24
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 read - a只是应用程序的简写,以使下面的代码更容易阅读。
-
ActiveSheet.Rows(1).Value
returns a 2-D array with dimensions (1 to 1, 1 to {number of columns in a worksheet}) - ActiveSheet.Rows(1)。值返回具有维数的二维数组(1到1,1到工作表中的列数)
- 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(). - 我们希望使用Join()将上面的数组压缩为单个值,这样我们就可以用与第二行不同的数组进行比较。然而,Join()只对一维数组起作用,所以我们通过application .转置()对数组运行了两次。注意:如果你比较的是列而不是行,那么你只需要一个转置()。
- 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. - 将Join()应用到数组中,给我们一个单独的字符串,其中原始的单元格值被一个“null字符”(Chr(0))分隔:我们选择这个字符串,因为它不太可能存在于任何单元格值本身中。
- After this we now have two regular strings which are easily compared
- 在这之后,我们现在有两个很容易比较的规则字符串
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在注释中指出的那样,转置()不能以超过approx的方式处理数组。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:与在从工作表中读取的数据的变体数组上使用的循环相比,此方法的性能相当差。如果要对大量的行进行逐行比较,那么上面的方法要慢得多。
#2
8
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
#3
5
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相似,我们只尝试匹配两个工作表的公用区域:
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
#4
1
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
#5
1
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转置法快,但它更灵活。由于要比较的项有100万项,所以列调用要花更长的时间!
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
#6
0
=EXACT(B2;D2) formula and drag down, best option for me.
=精确(B2;D2)公式,拖下来,对我来说是最好的选择。
#7
0
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")
as it does to pick up the entire range in one go using
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中,每次与纸张的交互所花费的时间是字符串比较的4倍,比浮点小数之间的比较长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.
所以你的代码可能会快四倍,也可能快一百倍,如果你一口气读完整个范围,然后计算范围。在VBA Value2数组。
That's in Office 2010 and 2013 (I tested them); for older version of Excel, you'll see quoted times between 1/50th and 1/500th of a second, for each VBA interaction with a cell or range of cells. That'll be way slower 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.
那是在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.
您将注意到,这个代码示例是通用的,适用于从任何地方获取的两个大小相同的范围——甚至来自不同的工作簿。如果您正在比较两个相邻的列,加载一个由两个列组成的数组,并比较arrX(i, 1) <> arrX(i,2)是否将运行时减半。
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”函数,它从range的. value2属性返回的2D数组中获取一个字符串。
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:
我包好了Windows系统。此VBA函数中的安全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
There are other VBA implementations out there, but nobody seems to know about the Byte Array / String type pun - they are not
equivalent, they are
identical - so everyone codes up unnecessary type conversions.
A fast and simple Join2D function was posted by Dick Kusleika on Daily Dose of Excel in 2015:
Dick Kusleika在2015年的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 * back in 2012.
如果在进行比较之前需要删除空行,则需要我在2012年*中发布的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。用公式代替Range1。但是你的问题是比较价值,而不是公式。
Footnote: I've posted a very similar answer elsewhere. I'd've posted it here first if I'd seen this question earlier.
脚注:我在其他地方发布了一个非常相似的答案。如果我早点看到这个问题的话,我早就把它贴在这里了。
#8
0
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 -功能- 357 b449a ec91 - 49 - d0 - 80 c3 - 0 - e8fc845691c
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
#1
24
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 read - a只是应用程序的简写,以使下面的代码更容易阅读。
-
ActiveSheet.Rows(1).Value
returns a 2-D array with dimensions (1 to 1, 1 to {number of columns in a worksheet}) - ActiveSheet.Rows(1)。值返回具有维数的二维数组(1到1,1到工作表中的列数)
- 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(). - 我们希望使用Join()将上面的数组压缩为单个值,这样我们就可以用与第二行不同的数组进行比较。然而,Join()只对一维数组起作用,所以我们通过application .转置()对数组运行了两次。注意:如果你比较的是列而不是行,那么你只需要一个转置()。
- 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. - 将Join()应用到数组中,给我们一个单独的字符串,其中原始的单元格值被一个“null字符”(Chr(0))分隔:我们选择这个字符串,因为它不太可能存在于任何单元格值本身中。
- After this we now have two regular strings which are easily compared
- 在这之后,我们现在有两个很容易比较的规则字符串
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在注释中指出的那样,转置()不能以超过approx的方式处理数组。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:与在从工作表中读取的数据的变体数组上使用的循环相比,此方法的性能相当差。如果要对大量的行进行逐行比较,那么上面的方法要慢得多。
#2
8
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
#3
5
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相似,我们只尝试匹配两个工作表的公用区域:
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
#4
1
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
#5
1
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转置法快,但它更灵活。由于要比较的项有100万项,所以列调用要花更长的时间!
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
#6
0
=EXACT(B2;D2) formula and drag down, best option for me.
=精确(B2;D2)公式,拖下来,对我来说是最好的选择。
#7
0
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")
as it does to pick up the entire range in one go using
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中,每次与纸张的交互所花费的时间是字符串比较的4倍,比浮点小数之间的比较长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.
所以你的代码可能会快四倍,也可能快一百倍,如果你一口气读完整个范围,然后计算范围。在VBA Value2数组。
That's in Office 2010 and 2013 (I tested them); for older version of Excel, you'll see quoted times between 1/50th and 1/500th of a second, for each VBA interaction with a cell or range of cells. That'll be way slower 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.
那是在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.
您将注意到,这个代码示例是通用的,适用于从任何地方获取的两个大小相同的范围——甚至来自不同的工作簿。如果您正在比较两个相邻的列,加载一个由两个列组成的数组,并比较arrX(i, 1) <> arrX(i,2)是否将运行时减半。
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”函数,它从range的. value2属性返回的2D数组中获取一个字符串。
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:
我包好了Windows系统。此VBA函数中的安全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
There are other VBA implementations out there, but nobody seems to know about the Byte Array / String type pun - they are not
equivalent, they are
identical - so everyone codes up unnecessary type conversions.
A fast and simple Join2D function was posted by Dick Kusleika on Daily Dose of Excel in 2015:
Dick Kusleika在2015年的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 * back in 2012.
如果在进行比较之前需要删除空行,则需要我在2012年*中发布的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。用公式代替Range1。但是你的问题是比较价值,而不是公式。
Footnote: I've posted a very similar answer elsewhere. I'd've posted it here first if I'd seen this question earlier.
脚注:我在其他地方发布了一个非常相似的答案。如果我早点看到这个问题的话,我早就把它贴在这里了。
#8
0
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 -功能- 357 b449a ec91 - 49 - d0 - 80 c3 - 0 - e8fc845691c
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