VBA 检查列是否相同

Question

I have two Sheets in Excel that I need to check if the columns are the same in both sheets before processing them.

I have created a macro to do this check, but I'm wondering if there is a better way to achieve this.

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

First of all you need to avoid selection; How to avoid using Select in Excel VBA macros

Specificaally about your code; I would try comparing two arrays as it always faster to work with arrays and also it doesn't need a dummy-sheet. However, your approach, except the selection part is faster in my mind. So I would include the explicit version of your approach shortly.

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

---

This is the explicit version of your method:

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

You could declare two arrays and compare that way...

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