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

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

vba excel

Vba 如何比较工作表中的两整行,vba,excel,Vba,Excel,我是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 d

我是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

Match=True
Row1length=工作表（“Sheet1”）。单元格（1，Columns.Count）。结束（xlToLeft）。列
Row2length=工作表（“Sheet2”）。单元格（1，Columns.Count）。结束（xlToLeft）。列
如果row1长度row2长度那么
“不平等
匹配=错误
其他的
对于i=1到第1行长度
如果工作表（“Sheet1”）.单元格（1，i），则为工作表（“Sheet2”）.单元格（1，i）赋值，然后
匹配=错误
退出
如果结束
下一个
如果结束
如果Match=True，则
调试。打印“匹配”
其他的
调试。打印“不匹配”
如果结束

发生了什么事：

只是

应用程序的简写，使下面的代码更容易阅读


ActiveSheet.Rows（1）.Value
返回一个二维数组，其中包含维度（1到1，1到{工作表中的列数}）
我们想使用Join（）
将上面的数组压缩成一个值，这样我们就可以将它与第二行的不同数组进行比较。但是，Join（）只适用于一维数组，因此我们通过Application.Transpose（）
运行数组两次。注意：如果比较的是列而不是行，那么只需要一次转置（）
将Join（）
应用于数组会得到一个字符串，其中原始单元格值由一个“空字符”分隔（Chr（0）
）：我们选择这个字符串，因为它不太可能出现在任何单元格值中
在这之后，我们现在有两个很容易比较的正则字符串


注意：正如Reafidy在评论中指出的，Transpose（）
无法处理超过65000个元素的数组，因此您不能使用这种方法来比较Excel版本中的两整列，其中工作表的行数超过此数（即任何非旧版本）
注2：与从工作表读取的变量数据数组上使用的循环相比，此方法的性能相当差。如果要对大量行进行逐行比较，则上述方法将慢得多。
好的，这应该相当快：Excel UI和VBA之间的交互最少（这是大部分缓慢的原因所在）。假设工作表的布局与$A$1
相似，并且我们仅尝试将两张工作表的UsedRange
的公共区域匹配：
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

公共子比较表（wks1作为工作表，wks2作为工作表）
暗行与长行比较，冷行与长行比较
rowsToCompare=检查计数（wks1.UsedRange.Rows.Count，wks2.UsedRange.Rows.Count，“行”）
colsToCompare=CheckCount（wks1.UsedRange.Columns.Count，wks2.UsedRange.Columns.Count，“Column”）
比较wks1、wks2、行比较、列比较
端接头
私有函数CheckCount（count1为Long，count2为Long，哪个为String）为Long
如果count1 count2那么
调试。打印“UsedRange”&“计数不同：”_
&count1和count2
如果结束
CheckCount=count2
如果count1
=精确（B2；D2）公式和向下拖动，这是我的最佳选择。
对于您的具体示例，这里有两种方法
不区分大小写：
MsgBox [and(1:1=2:2)]

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

区分大小写：
MsgBox [and(exact(1:1,2:2))]

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


下面是比较任意两个连续范围的通用函数
不区分大小写：
MsgBox [and(1:1=2:2)]

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

区分大小写：
MsgBox [and(exact(1:1,2:2))]

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

下面是一段代码，它将处理两个向量范围。您可以对两行两列运行它
不要认为它和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

为了完整起见，我将在这里给出一个大锤式的答案，因为“这两个范围相同吗？”这个问题是其他人“比较我的范围，然后做这个复杂的事情…”问题中未经检查的部分
你的问题是一个关于小范围的简单问题。我的答案是关于大范围的；但这个问题是一个很好的问题，也是一个更一般的答案的好地方，因为它简单明了：“这些范围不同吗？”和“有人篡改了我的数据吗？”与大多数商业Excel用户相关
对于典型的“比较我的行”问题，大多数答案都是VBA中的逐单元格读取和比较。这些答案的简单性值得称赞，但这种方法在大型数据集上的执行速度非常慢，因为：
每次读取一个单元格的范围非常慢；
逐对比较值效率很低，尤其是对于字符串，当值的数量达到数万个时，
第（1）点很重要：VBA使用var=Range（“A1”）
拾取单个单元格所需的时间与使用var=Range（“A1:Z1024”）
一次性拾取整个范围所需的时间相同
…而且每次与床单互动所需的时间是弦乐的四倍
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

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

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

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

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