Question

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

但是，我坚持使用VBA编码（以宏形式），从每个子工作簿中，他们可以更新主人。我需要它根据分配给每个工作的唯一ID号查找和更新主服务器中的工作行，并显示在子工作簿和主工作簿的同一列（D列）中。

非常感谢任何帮助或想法。

先谢谢

道歉。请查看我的示例子工作簿中的以下数据（抱歉，我无法正确格式化）以及下面的数据，当前的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列与子项相同，以下是未经测试的，并且基于if子列中的列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

VBA根据值查找和更新行

1 个答案: