Question

我对VBA很陌生，一直在努力寻找以下任何现有信息：

我有一个工作簿（excel 2013），其中包含一个包含数据/文本等的表（excel Table），就像主项目列表一样。在其他几个表格中，我有类似的数据表，但是对于子项目。我想要做的是在主页面上有一个点击按钮，其中包含主项目列表（第一张表格），一旦点击它将检查其他表格（子项目）上的表格，其中第1列中的是和将每一行（带有yes）复制到主项目表中的下一个可用行。第2列中有一个唯一的引用，必须进行检查，以便它不会重复行。

我已经开始使用我在这里找到的一些代码，但它是用于复制到新工作表，而不是表格，显然只是我正在尝试实现的功能的一部分。

Sub Button2_Click()
Dim r As Long, endRow As Long, pasteRowIndex As Long

endRow = 10
pasteRowIndex = 1

For r = 1 To endRow

    If Cells(r, Columns("B").Column).Value = "yes" Then
    Rows(r).Select
    Selection.Copy

    'Switch to the sheet where you want to paste it & paste
    Sheets("Sheet2").Select
    Rows(pasteRowIndex).Select
    ActiveSheet.Paste

    'Next time you find a match, it will be pasted in a new row
    pasteRowIndex = pasteRowIndex + 1


    'Switch back to your table & continue to search for your criteria
    Sheets("Sheet1").Select
    End If
Next r
End Sub

非常感谢任何帮助。

Answer 1

这里有两件大事需要考虑：

如何从一个表添加一行到另一个表？
如何确定表中是否已存在该行？

向表中添加新行

表格可以为您节省一些工作，因为您不必查找最后一行。要从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处理重复的方法有很多种 - 您可能还需要考虑几种不同的方案。例如，考虑以下情况： Tables

索引为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

单击按钮Excel 2013根据单元格值

1 个答案:

向表中添加新行

副本怎么样？

示例设置