这里有两件主要的事情需要考虑：
- 如何将一行从一个表添加到另一个表？
- 如何判断该行是否已经存在于表中？
向表中添加新行
表格可以为您节省一些工作，因为您不必找到最后一行。要从 Range 对象向表中添加新行，您可以按照以下示例函数的方式执行操作。
' Inserts a row to the table from a range object.
Private Function InsertTableRowFromRange(table As ListObject, source As Range)
Dim newRow As ListRow
Set newRow = table.ListRows.Add(AlwaysInsert:=True)
newRow.Range(1, 1).Resize(source.Rows.Count, source.Columns.Count) _
.Value = source.Value
End Function
然后您可以遍历其他表中的行并插入符合要求的范围。
' Inserts toggled rows from the source table to the target table.
Private Function InsertToggledRows(source As ListObject, target As ListObject)
Dim row As ListRow
For Each row In source.ListRows
If row.Range(1, 1).Value = "yes" Then
InsertTableRowFromRange target, row.Range
End If
Next
End Function
重复的呢？
有很多方法可以使用 VBA 处理重复项 - 您可能还需要考虑一些不同的场景。例如，考虑以下情况：
索引为 8 的项在两个不同的表中设置为yes，并且在每个表中具有不同的名称。应该使用哪个表？当一个项目在一个表中设置为 yes 而在另一个表中设置为 no 时会怎样？
对于上面屏幕截图中的结果，我将主表中的索引添加到 array 并使用 this answer 中的函数将潜在的新索引与数组中的索引进行比较。
InsertToggledRows 也需要进行一些更改，因为它现在还必须更新 indexes 数组。我在以下示例中采用的路径涉及一些尴尬的返回值，并且不是唯一的做事方式。
示例设置
Option Explicit
' Inserts toggled rows with unique identifiers from other tables to the master.
Public Sub InsertTablesToMasterTable()
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim masterTable As ListObject
Dim firstTable As ListObject
Dim secondTable As ListObject
Dim indexes() As Variant
Set ws = ThisWorkbook.Worksheets(1)
' Set your table objects to variables
With ws
Set masterTable = .ListObjects("Master")
Set firstTable = .ListObjects("Table1")
Set secondTable = .ListObjects("Table2")
End With
' Get the indexes from the existing table
indexes = GetInitialIndexes(masterTable)
' Insert the rows & update the indexes array
indexes = InsertUniqueToggledRows(firstTable, masterTable, indexes)
indexes = InsertUniqueToggledRows(secondTable, masterTable, indexes)
Application.ScreenUpdating = True
End Sub
' Returns an array of the initial indexes found in the table.
Private Function GetInitialIndexes(table As ListObject) As Variant
Dim arr() As Variant
ReDim arr(0 To table.ListRows.Count)
Dim row As ListRow
Dim i As Integer
i = 0
For Each row In table.ListRows
arr(i) = row.Range(1, 2).Value
i = i + 1
Next
GetInitialIndexes = arr
End Function
' Inserts toggled rows from the source table to the target table and returns
' an array which has the new indexes appended to the existing array.
Private Function InsertUniqueToggledRows( _
source As ListObject, _
target As ListObject, _
indexes As Variant _
) As Variant
Dim arr() As Variant
Dim row As ListRow
arr = indexes
For Each row In source.ListRows
If row.Range(1, 1).Value = "yes" And _
Not IsInArray(row.Range(1, 2).Value, indexes) Then
InsertTableRowFromRange target, row.Range
' Push the new index to the array
ReDim Preserve arr(0 To UBound(arr) + 1) As Variant
arr(UBound(arr)) = row.Range(1, 2).Value
End If
Next
InsertUniqueToggledRows = arr
End Function
' Inserts a row to the table from a range object.
Private Function InsertTableRowFromRange(table As ListObject, source As Range)
Dim newRow As ListRow
Set newRow = table.ListRows.Add(AlwaysInsert:=True)
newRow.Range(1, 1).Resize(source.Rows.Count, source.Columns.Count) _
.Value = source.Value
End Function
' Returns true if the string is found in the array.
Private Function IsInArray(stringToFind As String, arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr, stringToFind)) > -1)
End Function