Question

我有一张表（Master），应该根据另一张表（NewData）中的信息定期更新。在A列中，两个工作表中都有一个唯一的ID。在NewData工作表中可能会有一些新的id应该转移到Master工作表，如果NewData工作表有一个在Master工作表中注册的id，则应删除此id（整行）来自主表。换句话说：NewData工作表给出了哪个id在主工作表中的蓝图。

NewData工作表包含主工作表中某些列的更新数据。我不能盲目地在两张纸之间复制信息，因为用户可能在单元格中放了超链接 - 并且不应删除该超链接。

示例：

The Master sheet looks like this before update

The NewData sheet looks like this

我不允许发布两个以上的链接，所以我必须口头描述运行宏后更新的主表单的样子：

Rowid 2001（Kjell）应保持不变
应删除Rowid 2345（Vegard）（因为它不在NewData中片）
Rowid 1002（Fenja）应该和原版Master一样，但是新的描述和新的日期，现在没有日期超链接。
Rowid 1234（）应该是一个新行（在Name单元格中没有数据）

我想这可以通过相当简单的vba编程来解决，但我甚至不具备基本知识，在尝试了大量的复制/粘贴之后，尝试了vlookup和索引匹配......我拿了打扰这个社区的一步......很高兴，如果有任何可以帮助我的话！

Answer 1

我假设每个行ID在两个工作表中都是唯一的。如果是这样，您可以使用字典对象并使用主工作表中的所有值填充它。完成后，您可以遍历NewData工作表，如果字典中存在遇到的id，则更新Master记录（即该记录同时包含Master和NewData）;请注意，一旦完成，您就删除了字典键/值对。如果它不存在，那么您将它附加到主工作表的末尾（即该记录在NewData中但不在Master中）。

在循环完成之后，字典中的唯一条目是Master中存在但不存在于NewData中的键，可以删除 - 这是在最后一个循环中完成的操作：

Option Explicit


Sub updateMaster()
  Dim dict As Object
  Set dict = CreateObject("Scripting.Dictionary")

  Dim wrkM As Worksheet: Set wrkM = Worksheets("Master")
  Dim wrkD As Worksheet: Set wrkD = Worksheets("NewData")

  Dim r As Integer, r1 As Integer, lr As Integer
  Dim rng As Range
  Dim val As String
  With wrkM:
    lr = .Range("A" & .Rows.Count).End(xlUp).row
    For r = 2 To lr:
      Set rng = .Range("A" & r).EntireRow
      val = Trim(.Cells(r, "A").Value)
      Set dict(val) = rng
    Next
  End With
  lr = lr + 1

  Dim str As Variant
  With wrkD:
    For r = 2 To .Range("A" & .Rows.Count).End(xlUp).row:
      str = Trim(.Cells(r, "A").Value)
      If dict.Exists(str) Then
        Set rng = dict(str)
        r1 = rng.row
        wrkM.Cells(r1, "B").Value = .Cells(r, "B").Value
        wrkM.Cells(r1, "E").Value = .Cells(r, "C").Value
        wrkM.Cells(r1, "D").Value = .Cells(r, "D").Value
        dict.Remove str
      Else
        wrkM.Cells(lr, "A").Value = .Cells(r, "A").Value
        wrkM.Cells(lr, "B").Value = .Cells(r, "B").Value
        wrkM.Cells(lr, "D").Value = .Cells(r, "D").Value
        wrkM.Cells(lr, "E").Value = .Cells(r, "C").Value
        lr = lr + 1
      End If
    Next
  End With

  For Each str In dict.keys():
     Set rng = dict(str)
     rng.Delete
  Next

End Sub

如果你有一个连续的范围，你可以用以下内容替换else条件中的前两行：

.Range("A" & r, "B" & r).Copy Destination:=wrkM.Range("A" & lr, "B" & lr)

但是只有2行它没有效率。

宏循环并更新一些单元格

1 个答案: