Question

我在单独的选项卡上有2个表，这些选项卡具有多个具有相同名称的列。我想将这两个表的数据合并到第三个选项卡上的新表中。

我尝试了多种方法来实现这一点，例如只需对列位置进行硬编码（如A，B，C ..），并在需要复制的20个左右列中手动编码粘贴。但是，我宁愿运行我需要复制的列标题数组的循环，抓取数据并附加到第3个表。这样，如果位置移动它继续工作，我只需要担心列标题。我在使用数组或在VBA中使用命名表时没有那么先进，所以我希望有人可以帮助我。

示例：

Dim arr1 As Variant
Dim vItm As Variant
Dim tbl1 As ListObject
Dim tbl2 As ListObject
Dim tbl3 As ListObject


arr1 = Array("Header1", "Header2", "Header3")
Set tbl1 = Worksheets("Sheet1").ListObjects("Table1")
Set tbl2 = Worksheets("Sheet2").ListObjects("Table2")
Set tbl3 = Worksheets("Sheet3").ListObjects("Table3")

For Each vItm In arr1

    Set c = tbl2.ListColumns(vItm).DataBodyRange

    If Not c Is Nothing Then
        col = c.Column

          With tbl2.DataBodyRange
            tRows = .Rows.Count
            tCols = .Columns.Count
            Set CopyRng = .Range(.Cells(0, col), .Cells(tRows - 1, col))

          End With

          Set Dest = tbl1.HeaderRowRange.Find(vItm, LookIn:=xlValues, LookAt:=xlWhole, _
            MatchCase:=False, SearchFormat:=False)

          MsgBox Dest.Address

    Else
        MsgBox "Header not found"
        Exit Sub
    End If
Next vItm

对于数组中的每个列标题，请查看Table1并复制下面的所有数据并粘贴到Table3中相应的列标题中。对所有数组项执行此操作。然后对于数组中的每个列标题，请查看Table2并复制下面的所有数据并粘贴到Table1中来自Table1的数据中的相应列标题。

在这里感谢任何帮助。谢谢！

Answer 1

我想我已经解决了我的大多数问题，引用了正确的表和数据来复制和移动。我将在原始问题中发布完成的代码。但是现在我遇到了一些没有正确更新的变量的问题。就像我的sub末尾的这段代码一样。我重复使用了上一节中的copyrng，lastrow和lastcol。当我调试时，lastrow和lastcol显示正确的数字，但复制范围只选择列O（＃15）到最后一行。知道是什么导致了这个或如何重置变量？

With tbl3.DataBodyRange
CopyRng = .Range(Cells(1, 16), .Cells(lastRow, lastCol))

    With CopyRng
        .Copy
        Debug.Print .Address
        Debug.Print lastCol
    End With

结束

VBA循环表列名称并组合新工作表中的数据

1 个答案: