我正在尝试创建一个宏来比较两个用户输入的工作表,然后根据不同的原因将差异移动到不同的工作表。
代码首先要求输入最新数据并打开该表。然后它要求比较旧数据的位置,但不打开它。它添加了要复制到的必要工作表。
然后它在第二个工作簿上逐个单元格地查找匹配的序列(这主要是为了确保它比较正确的数据以防万一格式关闭)。一旦找到匹配的序列号,它就会比较两个条目的第二个序列号,并取决于它是不同的还是新的输入到其中一张表中。
我遇到的主要问题是 VLookup。它有多个错误 424、1004 和编译表达式错误。我需要一些指导来说明为什么会出现这些问题。我已经搜索并发现很多需要使用括号来引用文件,但是当我完全遵循这些格式时,它会引发表达式错误。
任何建议表示赞赏。
Sub Compare()
'Open workbooks
''Worksheet 1
Dim filter As String
Dim caption As String
Dim WB1FN As String
Dim WB1 As Workbook
filter = "Excel Sheets (*.xlsx),*.xlsx"
caption = "Please select newest equipment file"
MsgBox (caption)
WB1FN = Application.GetOpenFilename(filter, , caption)
If WB1FN = "False" Then
MsgBox "File not selected to import"
Exit Sub
End If
Set WB1 = Application.Workbooks.Open(WB1FN)
''Worksheet 2
Dim caption2 As String
Dim WB2FN As String
filter = "Excel Sheets (*.xlsx),*.xlsx"
caption2 = "Please select previous equipment file"
MsgBox (caption2)
WB2FN = Application.GetOpenFilename(filter, , caption)
If WB2FN = "False" Then
MsgBox "File not selected to import"
Exit Sub
End If
'Comparing data
''MS find and compare
Dim MS1 As String
Dim ESN1 As String
Dim ESN2 As String
Dim LastRow As Long
Dim i As Integer
Dim d As Integer
Dim n As Integer
Dim Filename As String
d = 4
n = 4
Set WB1 = ActiveWorkbook
'Create sheets
Sheets.Add(After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)).Name = "A"
Sheets.Add(After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)).Name = "B"
Sheets.Add(After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)).Name = "C"
'Gets the last row number
ActiveWorkbook.Sheets(1).Activate
LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
For i = 4 To LastRow
''Assigning MS1,ES1,ES2
MS1 = Cells(i, 6)
ESN1 = Cells(i, 15)
ESN2 = Application.WorksheetFunction.VLookup(MS1, '[" & WB2FN & "]Sheet1'! [R3C6:R10000C15], 10, False)
''Compare ESN and copy data
If ESN2 <> ESN1 Then
cell.EntireRow.Copy Sheets(2).Cells(d, 1)
n = d + 1
ElseIf Application.WorksheetFunction.IsNA(ESN2) = "TRUE" Then
cell.EntireRow.Copy Sheets(4).Cells(n, 1)
n = n + 1
End If
Next i
'X find and copy
Dim OEM As String
ActiveWorkbook.Sheets(2).Activate
LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
n = 3
i = 3
For i = 3 To LastRow
''Check for X
OEM = Cells(i, 4)
If OEM = "x" Then
cell.EntireRow.Copy Sheets(3).Cells(n, 1)
n = n + 1
End If
Next i
MsgBox "Compare successful"
End Sub