VBA 宏根据匹配的 ID 列替换数据

Question

我是 VBA 的新手，我有一个非常具体的要求，我可以使用一些帮助来弄清楚。

Sub Button2_Click()
Dim OpenFileName As String
Dim wb As Workbook
'Select and Open workbook
OpenFileName = Application.GetOpenFilename
If OpenFileName = "False" Then Exit Sub
Set wb = Workbooks.Open(OpenFileName)
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long

'Set variables for copy and destination sheets
'Use (1) instead of "Sheet1" or "Learners" to reference the first sheet within the workbook
Set wsCopy = Workbooks("Excel Test1.xlsx").Worksheets("Sheet1")
Set wsDest = Workbooks("Excel Test2.xlsm").Worksheets("Learners")

  '1. Find last used row in the copy range based on data in column A
  lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
    
  '2. Find first blank row in the destination range based on data in column A
  'Offset property moves down 1 row
  lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row

  wsCopy.Range("A2:E" & lCopyLastRow).Copy _
    wsDest.Range("A" & lDestLastRow)
    
  wsDest.Range("G2").Value = WorksheetFunction.Match(wsDest.Range("F2").Value, wsCopy.Range("A2:A11"), 0)
  
MsgBox ("Done")
End Sub

上面的代码用于按钮内部，以便打开不同的 Excel 电子表格并将数据复制到我的“主电子表格”中。

使用正在复制并粘贴到主电子表格中的数据，我还希望能够检查 ID 列，如果有任何 ID 匹配，我想用来自的所有相应 ID 数据替换匹配的 ID 行导入的电子表格。

下面的所有数据都是虚拟数据，不是真实的，但是，例如，如果 ID 5 (John Harris) 与 ID 5 (Michael Bailey) 匹配，那么我希望将 Michael Bailey 的所有数据替换为 John Harris 的数据。

我希望我所写的内容是有意义的，我将不胜感激。

Answer 1

试试这个：

Sub Button2_Click()
    
    Dim OpenFileName As String
    Dim wb As Workbook
    Dim wsCopy As Worksheet
    Dim wsDest As Worksheet
    Dim m, rw As Range
    
    OpenFileName = Application.GetOpenFilename 'Select and Open workbook
    If OpenFileName = "False" Then Exit Sub
    
    Set wb = Workbooks.Open(OpenFileName, ReadOnly:=True)
    Set wsCopy = wb.Worksheets("Data") 'for example
    
    For Each rw In wsCopy.Range("A2:E" & wsCopy.Cells(Rows.Count, "A").End(xlUp).Row).Rows
        'matching row based on Id ?
        m = Application.Match(rw.Cells(1).Value, wsDest.Columns("A"), 0)
        'if we didn't get a match then we add a new row
        If IsError(m) Then m = wsDest.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row 'new row
        rw.Copy wsDest.Cells(m, "A") 'copy row
    Next rw
    
    wb.Close False 'no save
        
End Sub