VBA 检查列是否相同

Question

我在 Excel 中有两个工作表，我需要在处理它们之前检查两个工作表中的列是否相同。

我已经创建了一个宏来执行此检查，但我想知道是否有更好的方法来实现此目的。

Sub CheckColumns()

Sheets("Source1").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Sheet1").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Source2").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Sheet1").Select
Range("A2").Select
ActiveSheet.Paste
Range("A3") = "=IF(A1=A2,0,1)"
Range("A3").Copy
Range("A2").Select
Selection.End(xlToRight).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Range(Selection, Selection.End(xlToLeft)).Select
ActiveSheet.Paste
Range("A4") = "=SUM(3:3)"
If Range("A4").Value = 0 Then
    MsgBox "Same Columns"
Else
    MsgBox "different Columns"
End If

End Sub

Answer 1

首先你需要避免选择； 如何避免在 Excel VBA 宏中使用 Select

具体关于您的代码； 我会尝试比较两个数组，因为使用数组总是更快，而且它不需要虚拟表。 但是，在我看来，除了选择部分之外，您的方法更快。 所以我很快就会包括你的方法的明确版本。

Sub CheckColumns()

Dim arrS1 As Variant, arrS2 As Variant
Dim LastRow As Long

   With Worksheets("Source1")
         LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
         arrS1 = .Range("A1:A" & LastRow)
   End With

   With Worksheets("Source2")
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        arrS2 = .Range("A1:A" & LastRow)
   End With

   If UBound(arrS1) <> UBound(arrS2) Then
      MsgBox "Different Columns"
      Exit Sub
   End If

   same = True 
   For i = LBound(arrS1) to UBound(arrS1) 
       If arrS1(i) <> arrS1(i) Then 
           same = False 
           Exit For 
       End If 
   Next i 
   
   If same = True Then 
       MsgBox "Same Column" 
   Else 
       MsgBox "Item " & i & " does not match. Stopped checking further" 
   End If 

End Sub

---

这是您的方法的显式版本：

Sub CheckColumns()

Dim rngrS1 As Range, rngS2 As Range, rngSH As Range
Dim LastRow1 As Long, LastRow2 As Long

   With Worksheets("Source1")
         LastRow1 = .Cells(.Rows.Count, "A").End(xlUp).Row
         Set rngS1 = .Range("A1:A" & LastRow)
   End With

   With Worksheets("Source2")
        LastRow2 = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set rngS2 = .Range("A1:A" & LastRow)
   End With

   If LastRow1 <> LastRow2 Or rngS1(1) <> rngS2(1) Then 
                              'Second condition checks names of the columns
      MsgBox "Different Columns"
      Exit Sub
   End If

   With Worksheets("Sheet1")
        Set rngSH = .Range("A1:A" & LastRow1)
   End With

   rngSH.Value = rngS1.Value
   Set rngSH = rngSH.Offset(0,1)
   rngSH.Value = rngS2.Value
   Set rngSH = rngSH.Offset(0,1)
   rngSH.formula "=IF(A1=B1,0,1)"
   
   Worksheets(Sheet1).Range("D2") = "Sum(C:C)"

   If Worksheets(Sheet1).Range("D2").Value <> 0 Then
      MsgBox "Different Columns"
   Else
      MsgBox "Same Columns"
   End If

End Sub

Answer 2

您可以声明两个数组并以这种方式进行比较...

Sub Compare()
Dim FirstSheet As Variant, SecondSheet As Variant
Dim a As Long, b As Long

FirstSheet = Sheets("Source1").Range("A1:" & _
Mid(Sheets("Source1").Range("A1").End(xlToRight).Address, 2, _
InStr(Right(Sheets("Source1").Range("A1").End(xlToRight).Address, _
Len(Sheets("Source1").Range("A1").End(xlToRight).Address) - 2), "$")) & 1)

SecondSheet = Sheets("Source2").Range("A1:" & _
Mid(Sheets("Source2").Range("A1").End(xlToRight).Address, 2, _
InStr(Right(Sheets("Source2").Range("A1").End(xlToRight).Address, _
Len(Sheets("Source2").Range("A1").End(xlToRight).Address) - 2), "$")) & 1)

On Error Resume Next
For a = 1 To WorksheetFunction.Max(Sheets("Source1").Range("A1:" & _
Mid(Sheets("Source1").Range("A1").End(xlToRight).Address, 2, _
InStr(Right(Sheets("Source1").Range("A1").End(xlToRight).Address, _
Len(Sheets("Source1").Range("A1").End(xlToRight).Address) - 2), "$")) & 1).Cells.Count, _
Sheets("Source1").Range("A1:" & Mid(Sheets("Source1").Range("A1").End(xlToRight).Address, 2, _
InStr(Right(Sheets("Source1").Range("A1").End(xlToRight).Address, _
Len(Sheets("Source1").Range("A1").End(xlToRight).Address) - 2), "$")) & 1))
    If FirstSheet(1, a) <> SecondSheet(1, a) Then b = b + 1
Next
On Error GoTo 0

If b = 0 Then
    MsgBox "Same Columns"
    Else
    MsgBox "different Columns"
End If

End Sub