比较两个不同列顺序的工作表
我试图比较Excel中的两个工作表，以find新的/更新的logging使用VBA。 （假定工作表1是旧的，并且工作表2具有潜在的新的/更新的条目）
这些表单中存储的信息非常相似，只是顺序不同而已。
例如：工作表1在列E中有街道地址，而工作表2在列H中有街道地址。还有许多其他的列是这样的。
我不确定从哪里开始。 我试图通过剪切和插入来匹配第一张的列，但是这很快就失控了。
另外，如果它是一个新的logging，它需要附加到数据的末尾。
**已更新，以允许定义“键”列。 只需将“iKeyCol = 2”行更改为所需的列。
这里是一些代码尝试。 我懒得修改我使用的所有代码，所以有些可能对你来说是额外的。 确保您的工作簿1.至less有三张（名称为“Sheet1，Sheet2，NewSheet”）2.具有Sheet1和Sheet2的列标题3. Col1必须在两张表中匹配4.列数必须在两张表中匹配。 其他那些col1，其他列可以以任何顺序。
将代码粘贴到一个新的模块和执行。
让我知道如果你有问题。
Option Explicit ' This module will compare differences between two worksheets. Sub Compare106thWorksheets() Dim iKeyCol As Integer '>>>> CHANGE THE FOLLOWING LINE TO IDENTIFY THE KEY COLUMN iKeyCol = 2 Dim i, i2, i3 As Integer Dim iRow As Long Dim iR1, iR2 As Long Dim iC1, iC2 As Integer Dim iColMap(30) As Integer Dim iCol1, iCol2 As Integer Dim LastRow1 As Long, LastRow2 As Long Dim LastCol1 As Integer, LastCol2 As Integer Dim MaxRow1 As Long Dim MaxCol1 As Integer Dim sFld1 As String, sFld2 As String Dim sFN1, sFN2 As String Dim rptWB As Workbook Dim DiffCount As Long Dim iLastRow, iLastColumn As Integer Dim strDeleted, strInserted As String Dim ws1 As Worksheet Dim ws2 As Worksheet Dim wsChg As Worksheet Dim iCHGRows As Long Dim iCHGCols As Long Application.ScreenUpdating = False Application.StatusBar = "Creating the report..." Set ws1 = ThisWorkbook.Worksheets("Sheet1") Set ws2 = ThisWorkbook.Worksheets("Sheet2") Set wsChg = ThisWorkbook.Worksheets("NewSheet") With ws1.UsedRange ' Get used range of Sheet1 LastRow1 = .Rows.Count LastCol1 = .Columns.Count End With With ws2.UsedRange ' Get used range of Sheet1 LastRow2 = .Rows.Count LastCol2 = .Columns.Count End With With wsChg.UsedRange ' Get used range of Sheet1 iCHGRows = .Rows.Count iCHGCols = LastCol1 End With MaxRow1 = LastRow1 MaxCol1 = LastCol1 Debug.Print ws1.Name & " has " & LastRow1 & " rows and " & LastCol1 & " columns." Debug.Print ws2.Name & " has " & LastRow2 & " rows and " & LastCol2 & " columns." If MaxRow1 < LastRow2 Then MaxRow1 = LastRow2 If MaxCol1 < LastCol2 Then MaxCol1 = LastCol2 ' Build a column map. Require both sheets to have the same names - but different order. For i = 1 To 30 iColMap(i) = 0 Next i For iC1 = 1 To MaxCol1 For i = 1 To LastCol2 If ws1.Cells(1, iC1) = ws2.Cells(1, i) Then iColMap(iC1) = i Exit For End If Next i Next iC1 ' Check if any column headers failed to match. For i = 1 To MaxCol1 If iColMap(i) = 0 Then MsgBox "Column named '" & ws1.Cells(1, i) & " not found in Sheet2. Please correct and start again." GoTo Exit_Code End If Next i strDeleted = "": strInserted = "" iR2 = 1 DiffCount = 0 For iR1 = 1 To MaxRow1 If ws1.Cells(iR1, iKeyCol) <> ws2.Cells(iR2, iKeyCol) Then ' Cell is different - is it an ADD or Delete? Debug.Print "Row: " & iR1 & vbTab & ws1.Cells(iR1, iKeyCol) & vbTab & "versus: " & ws2.Cells(iR2, iKeyCol) sFld1 = Trim(ws1.Cells(iR1, iKeyCol).FormulaLocal) sFld2 = Trim(ws2.Cells(iR2, iKeyCol).FormulaLocal) If sFld1 < sFld2 Then Debug.Print "Deleted Row " & ws1.Cells(iR1, iKeyCol) DiffCount = DiffCount + 1 wsChg.Cells(DiffCount, iKeyCol) = "Deleted:" wsChg.Cells(DiffCount, 2) = ws1.Cells(iR1, iKeyCol) strDeleted = strDeleted & ws1.Cells(iR1, iKeyCol) & vbCrLf iCHGRows = iCHGRows + 1 wsChg.Cells(iCHGRows, 1) = Now() For i = 1 To LastCol1 wsChg.Cells(iCHGRows, i + 1) = ws1.Cells(iR1, i) Next i ws1.Rows(iR1).EntireRow.Delete iR1 = iR1 - 1 GoTo Its_OK ElseIf sFld1 > sFld2 Then Debug.Print "Inserted Row " & ws2.Cells(iR1, iKeyCol) Debug.Print "R1: " & iR1 & " R2: " & iR2 & vbTab & ws1.Cells(iR1, iKeyCol) & vbTab & "versus: " & ws2.Cells(iR2, iKeyCol) DiffCount = DiffCount + 1 strInserted = strInserted & ws2.Cells(iR2, iKeyCol) & vbCrLf ws1.Rows(iR1).EntireRow.Insert For i = 1 To LastCol1 ws1.Cells(iR1, i) = ws2.Cells(iR2, iColMap(i)) Next i iR2 = iR2 + 1 GoTo Its_OK Else iR2 = iR2 + 1 End If Else ' Values are the same iR2 = iR2 + 1 End If Its_OK: Next iR1 Debug.Print "Deleted:" Debug.Print strDeleted Debug.Print "------------------------------------------------------------------" Debug.Print "Inserted:" Debug.Print strInserted Debug.Print "------------------------------------------------------------------" For iRow = 2 To LastRow2 Application.StatusBar = "Comparing cells " & Format(iCol1 / MaxCol1, "0 %") & "..." For iCol1 = 1 To LastCol1 iCol2 = iColMap(iCol1) sFld1 = "" sFld2 = "" On Error Resume Next sFld1 = ws1.Cells(iRow, iCol1).FormulaLocal sFld2 = ws2.Cells(iRow, iCol2).FormulaLocal On Error GoTo 0 If sFld1 <> sFld2 Then Debug.Print "Row: " & iRow & vbTab & ws1.Cells(iRow, iCol1) & vbTab & "versus: " & ws2.Cells(iRow, iCol2) DiffCount = DiffCount + 1 wsChg.Cells(DiffCount, 1) = ws1.Cells(iRow, iKeyCol) wsChg.Cells(DiffCount, 2) = ws1.Cells(1, iCol1) wsChg.Cells(DiffCount, 3) = sFld1 wsChg.Cells(DiffCount, 4) = sFld2 ws1.Cells(iRow, iCol1).FormulaLocal = ws2.Cells(iRow, iCol2).FormulaLocal End If Next iCol1 Next iRow wsChg.Activate Application.StatusBar = "Formatting the report..." With Range(Cells(1, 1), Cells(MaxRow1, MaxCol1)) .Interior.ColorIndex = 19 With .Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlHairline End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlHairline End With With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlHairline End With With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlHairline End With On Error Resume Next With .Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlHairline End With With .Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlHairline End With On Error GoTo 0 End With Columns("A:IV").ColumnWidth = 20 MsgBox DiffCount & " cells contain different formulas!", vbInformation, _ "Compare " & ws1.Name & " with " & ws2.Name Exit_Code: Application.StatusBar = False Application.ScreenUpdating = True End Sub