在两者中比较2个excel表和普通键
我正在寻找VBA代码来比较同一工作簿中的Excel工作表eg-Sheet1 vs Sheet2和Sheet3是供用户定义比较总行和列以及用于准备密钥的列 .
表格如下:
列和行不是固定的,因此如果用户获得了在sheet3和代码句柄中定义的选项 . 准备密钥 - 用户可以选择sheet3中的列 . 每个密钥的差异应填写在Sheet4中,其中包含Key和列,并且不同的值如下所示 -
工作表Sheet1
Column A CHDR 01234
Column B Life 01
Column C CRT abc
Column D Prem 10
Column E SA 1000
Sheet2中
Column A CHDR 01234
Column B Life 01
Column C CRT abc
Column D Prem 10
Column E SA 1002
键应该是列A,B,C因此应该在Sheet4中填充差异
Column A Key 01234-01-abc
Column B Difference SA-1000-1002
这是我目前的代码 -
Dim recordStatus As String
Dim oldCell As Range
Dim compareCell As Range
Dim keyToCompare As Variant
Dim i As Integer
Dim newCell As Range
Set newCell = Worksheets("CHDR-JSYS").Range("A2")
Do While newCell.Value <> ""
keyToCompare = newCell.Resize(1, 26).Value ' copy row of cells ... one extra cell at end
keyToCompare = Application.Transpose(keyToCompare) ' convert to
keyToCompare = Application.Transpose(keyToCompare) ' single dimension array
Set oldCell = Worksheets("CHDR-JACT").Range("A2") ' set pointer to cell A2
Do While oldCell.Value <> "" ' process all non-blank cells
Set compareCell = Worksheets("Compare").Range("A2") ' set pointer to cell A1
If oldCell.Value = keyToCompare(1) Then
If ( _
(oldCell.Offset(0, 1).Value = keyToCompare(2)) _
And (oldCell.Offset(0, 2).Value = keyToCompare(3)) _
And (oldCell.Offset(0, 3).Value = keyToCompare(4)) _
And (oldCell.Offset(0, 4).Value = keyToCompare(5)) _
And (oldCell.Offset(0, 5).Value = keyToCompare(6)) _
And (oldCell.Offset(0, 6).Value = keyToCompare(7)) _
And (oldCell.Offset(0, 7).Value = keyToCompare(8)) _
And (oldCell.Offset(0, 8).Value = keyToCompare(9)) _
And (oldCell.Offset(0, 9).Value = keyToCompare(10)) _
And (oldCell.Offset(0, 10).Value = keyToCompare(11)) _
And (oldCell.Offset(0, 11).Value = keyToCompare(12)) _
And (oldCell.Offset(0, 12).Value = keyToCompare(13)) _
And (oldCell.Offset(0, 13).Value = keyToCompare(14)) _
And (oldCell.Offset(0, 14).Value = keyToCompare(15)) _
And (oldCell.Offset(0, 15).Value = keyToCompare(16)) _
And (oldCell.Offset(0, 16).Value = keyToCompare(17)) _
And (oldCell.Offset(0, 17).Value = keyToCompare(18)) _
And (oldCell.Offset(0, 18).Value = keyToCompare(19)) _
And (oldCell.Offset(0, 19).Value = keyToCompare(20)) _
And (oldCell.Offset(0, 20).Value = keyToCompare(21)) _
And (oldCell.Offset(0, 21).Value = keyToCompare(22)) _
And (oldCell.Offset(0, 22).Value = keyToCompare(23)) _
And (oldCell.Offset(0, 23).Value = keyToCompare(24)) _
And (oldCell.Offset(0, 24).Value = keyToCompare(25))) Then
recordStatus = "No Change"
Else
recordStatus = "Change"
End If
Else
recordStatus = "New Record"
End If
keyToCompare(26) = recordStatus
For i = 1 To 25 ' update 5 cells in output workbook
compareCell.Offset(0, i).Value = keyToCompare(i + 1)
Next i
Set oldCell = oldCell.Offset(1, 0) ' move pointer one cell down
Set compareCell = compareCell.Offset(1, 0) ' this is missing from original code
Loop
Set newCell = newCell.Offset(1, 0)
Loop
End Sub
但我无法在其中添加更多列进行比较,因为它给了我错误“太多行继续” . 我必须比较超过40-50列 .
在此先感谢您的帮助
2 years ago
您可以使用循环代替所有这些
And
行:根据您的需要调整循环
For c = 1 To 24
,例如 . 列数要检查 .