Excel 从外部报告比较、更新或复制数据

我试图比较一个主计划文件（我们称之为main.xlsm）和我们的ERP系统（ERP.xlsm）提供的数据

我希望：

1） 打开窗口以选择源文件（ERP系统转储）

2） 比较两个文件（Main.xlsm中的Sheet RAPORT和ERP.xlsm中的Sheet 1）中F列的唯一ID值，并：

• 如果Main.xlsm和ERP.xlsm之间存在匹配，则使用ERP中的值更新Main中的值（所有数据-行a:AK）

• 如果ERP中有一个条目，但Main中没有条目，则添加具有该ID的整行（A:AK）

• 如果主文件中有条目，但ERP中没有数据，则将值“0”放在主文件的“R”行中

奖励轮次：每次发生上述情况时，在其更改的唯一ID所在行的“AL”列中放置一个时间/日期戳

我尝试了下面的代码（原始版本，未经我修改）。我不知道如何从上面实现这一切

子导入\u票据（）
'当活动文件是主票证列表且活动工作表是票证列表时，运行此操作
'导出的文件必须已打开，并且票证列表必须是活动工作表
将导出的文件设置为字符串
exported_file=“exported file.xlsx”
header_exists=True'如果导出的文件没有头，请将其设置为false！
起始行=1
如果标题_存在，则开始_行=2
变暗第一行\u空白\u尽可能长
第一行=单元格。特殊单元格（xlCellTypeLastCell）。偏移量（1，0）。行
变暗，变长
r=起始行
作为射程找到的昏暗
cur\u ticket\u num=工作簿（导出的文件）.ActiveSheet.Range（“a”&r）.Value
不执行时执行cur_ticket_num=“”
'在主文件中查找当前票证号
Set found=Columns（“a:a”）.Find（what:=cur\u ticket\u num，LookIn:=xlValues，lookat:=xlWhole）
如果发现什么都没有
'将信息添加到主文件的末尾
从导出文件r的第一行空白行写入行
第一行=第一行+1
其他的
'覆盖主文件的现有行
从导出的文件r中写入行。行
如果结束
r=r+1
cur\u ticket\u num=工作簿（导出的文件）.ActiveSheet.Range（“a”&r）.Value
环
端接头
从导出子写入行（src\u文件名为字符串，src\u r为长，dest\u r为长）
对于c=1到24
单元格（dest\u r，c）.Value=工作簿（src\u文件名）.ActiveSheet.Cells（src\u r，c）.Value
下一个c
端接头

---

下面是一个使用Dictionary对象比较两张工作表之间的ID列的示例

Sub import_tickets()

  Dim sERPFileName As String
  Dim wbERP As Workbook, wsERP As Worksheet
  Dim wbMain As Workbook, wsMain As Worksheet
  Dim r, startrow, lastrow As Long
  Dim ID
  Dim dictERP
  Set dictERP = CreateObject("Scripting.Dictionary")

  With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False
    .Show
    sERPFileName = .SelectedItems(1)
  End With

  Application.ScreenUpdating = False

  ' process ERP workbook
  Set wbERP = Workbooks.Open(sERPFileName, , xlReadOnly)
  Set wsERP = wbERP.Sheets("Sheet1")
  startrow = 2 ' assume has header
  lastrow = wsERP.Cells(Rows.Count, "F").End(xlUp).Row

  For r = startrow To lastrow
   ID = wsERP.Range("F" & r).Value
   If dictERP.exists(ID) Then
     MsgBox "Duplicate ID (" & ID & ") found in " & sERPFileName
   Else
     dictERP.Add ID, r
   End If
  Next r

  ' process MAIN workbook
  Set wbMain = ThisWorkbook
  Set wsMain = wbMain.Sheets("RAPORT")
  startrow = 2 ' assume has header
  lastrow = wsMain.Cells(Rows.Count, "F").End(xlUp).Row

  For r = startrow To lastrow
   ID = wsMain.Range("F" & r).Value
   If dictERP.exists(ID) Then
     ' update
     wsERP.Rows(dictERP(ID)).Columns("A:AK").Copy wsMain.Range("A" & r)
     wsMain.Range("L" & r) = "Updated " & Now
     dictERP.Remove (ID)
   Else
     ' set col R = 0
     wsMain.Range("R" & r).Value = 0
     wsMain.Range("L" & r) = "No Change " & Now
   End If
  Next r

  ' add from ERP those not matched
  If dictERP.Count > 0 Then
    For Each ID In dictERP.keys
      r = dictERP(ID)
      lastrow = lastrow + 1
      wsERP.Rows(r).Columns("A:AK").Copy wsMain.Range("A" & lastrow)
      wsMain.Range("L" & lastrow) = "Added " & Now
    Next
  End If

  wbERP.Close
  Application.ScreenUpdating = True

  If dictERP.Count Then
    MsgBox dictERP.Count & " rows added"
  Else
    MsgBox "Done"
  End If
End Sub

---

太神了它工作完美！非常非常感谢：）

Sub import_tickets()

  Dim sERPFileName As String
  Dim wbERP As Workbook, wsERP As Worksheet
  Dim wbMain As Workbook, wsMain As Worksheet
  Dim r, startrow, lastrow As Long
  Dim ID
  Dim dictERP
  Set dictERP = CreateObject("Scripting.Dictionary")

  With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False
    .Show
    sERPFileName = .SelectedItems(1)
  End With

  Application.ScreenUpdating = False

  ' process ERP workbook
  Set wbERP = Workbooks.Open(sERPFileName, , xlReadOnly)
  Set wsERP = wbERP.Sheets("Sheet1")
  startrow = 2 ' assume has header
  lastrow = wsERP.Cells(Rows.Count, "F").End(xlUp).Row

  For r = startrow To lastrow
   ID = wsERP.Range("F" & r).Value
   If dictERP.exists(ID) Then
     MsgBox "Duplicate ID (" & ID & ") found in " & sERPFileName
   Else
     dictERP.Add ID, r
   End If
  Next r

  ' process MAIN workbook
  Set wbMain = ThisWorkbook
  Set wsMain = wbMain.Sheets("RAPORT")
  startrow = 2 ' assume has header
  lastrow = wsMain.Cells(Rows.Count, "F").End(xlUp).Row

  For r = startrow To lastrow
   ID = wsMain.Range("F" & r).Value
   If dictERP.exists(ID) Then
     ' update
     wsERP.Rows(dictERP(ID)).Columns("A:AK").Copy wsMain.Range("A" & r)
     wsMain.Range("L" & r) = "Updated " & Now
     dictERP.Remove (ID)
   Else
     ' set col R = 0
     wsMain.Range("R" & r).Value = 0
     wsMain.Range("L" & r) = "No Change " & Now
   End If
  Next r

  ' add from ERP those not matched
  If dictERP.Count > 0 Then
    For Each ID In dictERP.keys
      r = dictERP(ID)
      lastrow = lastrow + 1
      wsERP.Rows(r).Columns("A:AK").Copy wsMain.Range("A" & lastrow)
      wsMain.Range("L" & lastrow) = "Added " & Now
    Next
  End If

  wbERP.Close
  Application.ScreenUpdating = True

  If dictERP.Count Then
    MsgBox dictERP.Count & " rows added"
  Else
    MsgBox "Done"
  End If
End Sub