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

首先，你需要避免选择; How to avoid using Select in Excel VBA macros

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

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

VBA检查列是否相同

2 个答案: