Сравнить, обновить или скопировать данные из внешнего отчета

Question

Я пытаюсь сравнить основной файл планирования (назовем его Main.xlsm) и данные, предоставляемые нашей системой ERP (ERP.xlsm).

Я ищу:

1) открыть окно для выбора исходного файла (системный дамп ERP).

2) сравнить значения уникальных идентификаторов из столбца F в оба файла (Sheet RAPORT в Main.xlsm и Sheet1 в ERP.xlsm) и:

• Если есть совпадение между Main.xlsm и ERP.xlsm - обновить значения в Main со значениями из ERP (все данные - строки A: AK)

• , если есть запись в ERP, но нет записи в Main - добавить всю строку с этим идентификатором (A: AK)

• если есть запись в Main, но нет данных в ERP - поместите значение "0" в строке "R" в главном файле

Bonus раунд: каждый раз, когда происходит что-то из вышеперечисленного, поместите отметку времени / даты в столбце «AL» в строке с уникальным идентификатором, который он изменил.

Я попробовал код ниже (оригинальная версия, не измененная мной ). Я не могу понять, как добиться всего сверху.

Sub import_tickets()
    'run this when the active file is the main ticket list and the active sheet is the ticket list
    'exported file must be open already, and the ticket list must be the active sheet
    Dim exported_file As String
    exported_file = "exported file.xlsx"
    header_exists = True 'if exported file doesn't have a header, set this to false!
    starting_row = 1
    If header_exists Then starting_row = 2

    Dim first_blank_row As Long
    first_blank_row = Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Row

    Dim r As Long
    r = starting_row
    Dim found As Range
    cur_ticket_num = Workbooks(exported_file).ActiveSheet.Range("a" & r).Value
    Do While Not cur_ticket_num = ""
        'look for current ticket number in main file
        Set found = Columns("a:a").Find(what:=cur_ticket_num, LookIn:=xlValues, lookat:=xlWhole)
        If found Is Nothing Then
            'add info to end of main file
            write_line_from_export exported_file, r, first_blank_row
            first_blank_row = first_blank_row + 1
        Else
            'overwrite existing line of main file
            write_line_from_export exported_file, r, found.Row
        End If
        r = r + 1
        cur_ticket_num = Workbooks(exported_file).ActiveSheet.Range("a" & r).Value
    Loop
End Sub

Sub write_line_from_export(src_filename As String, src_r As Long, dest_r As Long)
    For c = 1 To 24
        Cells(dest_r, c).Value = Workbooks(src_filename).ActiveSheet.Cells(src_r, c).Value
    Next c
End Sub

Answer 1

Вот пример, который использует объект 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