从外部数据向现有表添加新行,且无重复

时间:2018-12-06 05:35:59

标签: excel vba

我有一个包含现有工人姓名,ID和地址的电子表格。

这些工人被多次雇用和解雇。

我拉出一份报告(来自网站的外部数据),其中列出了这些工人的姓名,ID和当前使用的地址。

我不想在表(MASTER工作表上的表)上添加和删除这些工作程序的行以匹配报告(EXTERNAL DATA工作表上的数据),而是想从报告中添加工作程序的行(外部数据表)自动复制到我的表格(主表)中。

我需要添加整行的原因是因为我在表中(主表上)有更多列,因此我可以添加他们的职称,轮班和奖励工资。因此,当我删除工作程序时,我需要删除整行...

我需要一些代码来将一个工作表上的外部数据表(EXTERNAL DATA工作表)中的行添加到另一工作表中的我的MASTER表中,而无需重复工作。

此代码现在对我的工作表非常有效。我也许可以在一些帮助下修改此代码...

`Private Sub Worksheet_Change(ByVal Target As Range)
' Code to move row from FIRED sheet to MASTER sheet when “REHIRED” is 
'selected in column J
  If Target.Column = 2 Then
' The line below is where I should change to something to compare if there 
'is a new number 
'in the "NUMBER" column of the "EXTERNAL DATA" sheet then move the row to  
'the "MASTER" table. 
  If Target = "REHIRED" Then
    Application.EnableEvents = False
    nxtRow = Sheets("MASTER").Range("H" & Rows.Count).End(xlUp).Row + 1
    Target.EntireRow.Copy _
    Destination:=Sheets("MASTER").Range("A" & nxtRow)
    Target.EntireRow.Delete
  End If
 End If
 Application.EnableEvents = True
End If
End Sub`

我希望这是有道理的。

1 个答案:

答案 0 :(得分:1)

编辑:已更新/经过测试。假设两组数据都格式化为Tables / ListObjects:

Sub Tester()

    Dim lo As ListObject, loExt As ListObject, lr As ListRow
    Dim rw As Range, shtExt As Worksheet, f As Range, shtMaster As Worksheet
    Dim rwNew As Range

    Set shtExt = Sheets("external data")
    Set shtMaster = Sheets("master")
    Set lo = shtMaster.ListObjects(1) 'or use the table name
    Set loExt = shtExt.ListObjects(1) 'assumes the external data is a listobject

    For Each lr In loExt.ListRows

        'try to find the Id on the master sheet
        Set f = lo.ListColumns(1).Range.Find(lr.Range(1).Value, lookat:=xlWhole)
        If f Is Nothing Then

            'no match: add a new row to the table
            Set rwNew = shtMaster.ListObjects(1).ListRows.Add().Range
            'populate the new row
            rwNew.Cells(1).Value = lr.Range(1).Value
            rwNew.Cells(2).Value = lr.Range(2).Value
            rwNew.Cells(3).Value = lr.Range(3).Value
            'etc transfer any other required values...

        End If
    Next lr

End Sub
相关问题