VBA根据值查找和更新行

Question

我有一个主工作簿和多个子工作簿，每个工作簿都位于固定位置，它们将工作记录保存为单独的行。根据选择的工作簿，将行从主工作簿复制到子工作簿。

但是，我坚持使用 VBA 编码（以宏形式），因此他们可以从每个子工作簿中更新主工作簿。我需要它根据分配给每件作品并出现在子工作簿和主工作簿的同一列（D 列）中的唯一 ID 号来查找和更新主文件中的工作行。

任何帮助或想法将不胜感激。

提前致谢

抱歉。请查看我的示例子工作簿中的以下数据（抱歉，我无法正确格式化），在此之下，我必须将当前 VBA 代码复制回主工作簿：

数据：

Complaint Type  Raised by   Status      ID
Billing         Percy       Completed   101
Billing         Percy       Completed   102
Metering        John        Pending     103
Reads           John        Pending     104
Reads           Jack        Pending     105
Billing         Julie       Untouched   106
Service         Jack        Completed   107
Metering        Julie       Untouched   108
Service         Percy       Pending     109
Payment         Pete        Pending     110

VBA 代码：

Private Sub CommandButton21_Click()

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

 Dim SourceRange As Range, DestRange As Range

 Set SourceRange = Sheets("Sheet1").Range("A2:D2") 'data source
 wb = ActiveWorkbook.Name

 Workbooks.Open "C:\Users\user\Desktop\Test.xlsm" 'path to Master
 Windows(wb).Activate 'Activate Child Workbook
 SourceRange.Cut 'define the range to copy 'Cut data from child workbook

 Windows("Test.xlsm").Activate 'Activate Master
 Sheets("Completed").Select 'Activate Sheet
 Workbooks("Test.xlsm").Sheets("Completed").Cells(Rows.Count, "A").End(xlUp).Offset(1).Paste 'Paste in Master

 Application.CutCopyMode = False 'Clear Clipboard

 End Sub

Answer 1

下面的代码可以放在您的每个子工作簿中，我不确定 ID 出现在主工作簿中的哪个位置，所以我只是假设 D 列与子工作簿相同，以下代码未经测试且基于 D 列在子项中匹配主项中的 D 列，它将更新 A、B 和 C 列。目前它只对 2000 行执行此操作，如果适用，请更改。 :)

Dim fpath As String
Dim owb As Workbook
Dim Master As Worksheet 
Dim Slave As Worksheet 'the following declares both master and slave as worksheets

fpath = "location of master workbook" 


Set owb = Application.Workbooks.Open(fpath) 'opens the file path

Set Master = ThisWorkbook.Worksheets("name of sheet in child workbook") 'declares this workbook and sheet as "master"
Set Slave = owb.Worksheets("name of sheet in master you are pasting to") 'declares the workbook and sheet you're copying to as "slave"


For j = 1 To 2000 '(the master sheet) 'goes through each row from 1 to 2000

For i = 1 To 2000 '(the slave sheet) 'again does the same and the slave sheet
    If Trim(Master.Cells(j, 4).Value2) = vbNullString Then Exit For 'if the ID is blank it will exit and move on to the next row
    If Master.Cells(j, 4).Value = Slave.Cells(i, 4).Value Then 'the 4 represents column D, if cell in column D matches the cell in column D in the masterwork book then it will..
            Slave.Cells(i, 1).Value = Master.Cells(j, 1).Value 'cell in column A child workbook equals cell in column A in master workbook
            Slave.Cells(i, 2).Value = Master.Cells(j, 2).Value
            Slave.Cells(i, 3).Value = Master.Cells(j, 3).Value 'same for B and C


    End If
    Next


Next


MsgBox ("Data Transfer Successful")

With owb
.Save
.Close
End With