有沒有辦法比較兩個 excel 工作簿中的值？

Question

大家好，祝你新年快樂！

我的目標是打開一個工作簿，比如說工作簿 A，我想將整個工作簿復制到工作簿 B，但是我想比較包含兩個不同數字的兩列。 因此，如果工作簿 A 具有這些數字，而工作簿 B 具有這些數字，則將整個行從工作簿 A 復制到工作簿 B，並覆蓋它。 工作簿 B 總是產生新數據，我想在它覆蓋當前行時保留它。

到目前為止，這是我的代碼，它只是打開了一個對話框，顯示 select 與哪個文件進行比較，並將整個工作表從工作簿 A 復制到工作簿 B，但我正在為此苦苦掙扎。 任何幫助，將不勝感激。

Option Explicit

Dim fullpath As String

Sub copyDATA()
 
  With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
        .Show
        
        fullpath = .SelectedItems.Item(1)
    End With
    
    If InStr(fullpath, ".xls") = 0 Then
        Exit Sub
    End If

Worksheets("Daily").Range("A1:Q2000").Copy

Workbooks.Open Filename:= _
fullpath
    
ActiveSheet.Paste Destination:=Worksheets("Daily").Range("A1")

End Sub

我有一個以前的日期工作簿，其中包含所有格式、評論和其他內容。 新工作簿在沒有格式化或任何內容的情況下生成，但在單元格中更新了數據。 我需要做的是將以前的工作簿復制或合並到新生成的工作簿中，它會攜帶所有內容，包括格式化，但將新數據單獨留在新工作簿中。

Answer 1

假設您要比較的列在兩個工作簿中都是“B”和“C”

Option Explicit

Sub copyDATA()
   
    Const SHT_NAME = "Daily"
    Const COL_KEY1 = "B"
    Const COL_KEY2 = "C"

    Dim wbA As Workbook, wsA As Worksheet
    Dim wbB As Workbook, wsB As Worksheet, row As Range
    Dim iLastrowA As Long, iLastrowB As Long, iRow As Long
    Dim FileName As String, count(2) As Long

    ' choose workbook A
    Dim fullpath As String
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
        If .Show = False Then Exit Sub
        FileName = .SelectedItems.Item(1)
    End With
    
    ' check is xls
    If InStr(FileName, ".xls") = 0 Then
        Exit Sub
    End If
   
    ' workbook B is this workbook
    Set wbB = ThisWorkbook
    Set wsB = wbB.Sheets(SHT_NAME)

    ' build dict of existing key numbers
    Dim dict As Object, key
    Set dict = CreateObject("Scripting.Dictionary")
    iLastrowB = wsB.Cells(Rows.count, COL_KEY1).End(xlUp).row
    For iRow = 1 To iLastrowB
        key = Trim(wsB.Cells(iRow, COL_KEY1)) & _
              Trim(wsB.Cells(iRow, COL_KEY2))
        If dict.exists(key) Then
            MsgBox "Dupicate key " & key & " at row " & iRow, vbCritical
            Exit Sub
        ElseIf Left(key, 7) Like "#######" Then ' 7 digit number
            dict(key) = iRow
        End If
    Next

    ' source data
    Application.ScreenUpdating = False
    Set wbA = Workbooks.Open(FileName, True, True)
    Set wsA = wbA.Sheets(1)
    iLastrowA = wsA.Cells(Rows.count, COL_KEY1).End(xlUp).row
    For iRow = 1 To iLastrowA
        key = Trim(wsA.Cells(iRow, COL_KEY1)) & _
              Trim(wsA.Cells(iRow, COL_KEY2))
        Set row = wsA.Cells(iRow, 1).Resize(1, 17) 'A to Q
        If dict.exists(key) Then
            ' update values only
            row.Copy
            wsB.Cells(dict(key), 1).PasteSpecial xlPasteValues
            count(1) = count(1) + 1
            'highlight updated row - comment out when working
            wsB.Cells(dict(key), 1).Interior.Color = RGB(255, 255, 0)
        
        ElseIf Left(key, 7) Like "#######" Then ' valid 7 digit numbers
            ' add if needed later
            'iLastrowB = iLastrowB + 1
            'row.Copy
            'wsB.Cells(iLastrowB, 1).PasteSpecial xlPasteValues
            'count(2) = count(2) + 1
            'wsB.Cells(iLastrowB, 1).Interior.Color = RGB(0, 255, 0) 'g
        End If
        Application.CutCopyMode = False
    Next
    Application.ScreenUpdating = True
    MsgBox count(1) & " rows updated " & count(2) & " added from " & wbA.Name, vbInformation
    wbA.Close False

End Sub