VBA根据值查找和更新行 [英] VBA to find and update row based on value

问题描述

我有一本主要的工作簿和多个孩子的工作簿，每个工作簿都在固定的位置，它们作为单独的行保存工作记录。将行从主工作簿复制到基于哪些工作簿的儿童工作簿。

I have a master workbook and multiple children workbooks, each in fixed locations, which hold records of work as individual rows. Rows are copied from the master workbook to the children workbooks based on which of the workbooks are selected.

但是，我被困在VBA编码（以宏格式）从每个孩子的工作簿中，他们可以更新主人。我需要它根据分配给每个作品的唯一ID号码，在子版和主工作簿中的同一列（列D）中查找和更新主文件中的工作行。

However, i'm stuck for the VBA coding (in macro form) whereby from within each of the children workbooks, they can update the master. I need it to find and update the work row in the master based on the unique ID number which is assigned to each piece of work and appears in the same column (column D) in both the children and master workbooks.

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

Any help or ideas would be much appreciated.

感谢提前

道歉。请参阅我的示例子工作簿中的以下数据（对不起，我无法正确格式化），而在下面，当前的VBA代码我必须复制到主工作簿：

Apologies. Please see below data from my sample child workbook (sorry I couldn't format it properly) and below that, the current VBA code I have to copy back to the master workbook:

数据：

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

推荐答案

下面的代码可以在你的每个孩子的工作簿中，我不知道ID在主工作簿中出现的位置，所以我只是假定列D与孩子一样，下面是未经测试的，基于如果孩子中的列D匹配列D i在主机上，它将更新列A，B和C.目前，它只执行2000行，如果适用，则更改。 ：）

The below code can go in each of your children workbooks, I wasn't sure where the ID appeared in the master workbook so I just assumed column D the same as the children, the below is untested and based on if column D in the child matches column D in the master it will update column A, B and C. At the moment it only does it for 2000 rows, change if applicable. :)

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根据值查找和更新行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！