VBA检查列是否相同

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

我创build了一个macros来做这个检查，但我想知道是否有更好的方法来实现这一点。

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

首先你需要避免select; 如何避免在Excel VBAmacros中使用select

具体说明你的代码; 我会尝试比较两个数组，因为它总是更快地处理数组，也不需要一个虚拟工作表。 但是，你的方法，除了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