粘贴数据-Excel的其他Listobject中Listobject的范围 [英] Paste data - ranges of Listobjects in other Listobject of Excel

问题描述

我正在使用VBA在excel中的表之间移动数据(ListObjects) 而且我想避免循环，因为它们太浪费时间了

I am using VBA to move data between tables in excel (ListObjects) And I want to avoid loops for they are too much time consuming

我有一个第一个(原始)表，称为:tabl1 第二个原始表:tbl2

I have a first (origin) table called:tabl1 and a second origin table: tbl2

我有一个命运表，叫:tbl3 这个表是空的，所以databodyrange没什么

I have a destiny table called:tbl3 this table is empty, so databodyrange is nothing

我想将两个原始表tbl1和tbl2中的数据粘贴到tbl3中

I would like to paste data from the two origin tables tbl1 and tbl2 into tbl3

Dim tbl1 As ListObject
Dim tbl2 As ListObject
Dim tbl3 As ListObject
Set tbl1 = ThisWorkbook.Sheets(1).ListObjects("table1")
Set tbl2 = ThisWorkbook.Sheets(1).ListObjects("table2")
Set tbl3 = ThisWorkbook.Sheets(1).ListObjects("table3")

'delete the data of table 3
If Not tbl3.DataBodyRange Is Nothing Then
    tbl3.DataBodyRange.Delete
End If

'Adding a first row to avoid that databodyrange isnothing
tbl3.ListRows.Add
'this code does not work
'What I try to do is copy the range of column1 of table1 and paste it in the first 
tbl1.ListColumns(1).DataBodyRange.Copy Destination:=tbl3.ListColumns(1).DataBodyRange.Item(1).Address

我不想使用循环(太慢) 而且我不想使用".select":太容易出错.

I dont want to use loop (too slow) And I dont want to use ".select": too error-prone.

当然，表三中粘贴的数据必须是表的一部分.

And of course, the data pasted in table three has to be part of the table.

在此链接中，我发布了自己(并回答了)该问题的部分解决方案: Excel复制数据来自列表对象A(tableA)的几列到另一列的列表对象B(tableB)

In this link I posted myself (and answered) a partial solution to the problem: Excel copy data from several columns of listobject A (tableA) into one column of listobject B (tableB) one after the other

但是我真的很想找到一个解决方案，只引用列表对象的名称，而不引用工作表中的绝对位置(否则移动列表对象会使解决方案无效).

but I would really like to find a solution referring only to the name of listobjects and not to absolute positions in a sheet (otherwise moving the listobject would invalidate the solution).

这里是说明的问题.请注意，为了清楚起见，我将三个表放在一张纸上，但是这些表分布在不同的纸上.

Here is the problem illustrated. Be aware that I put the three tables in one sheet for clarity purposes but the tables are distributed in different sheets.

这是期望的结果:

推荐答案

尝试一下:

Dim TBL1 As ListObject
Dim TBL2 As ListObject
Dim TBL3 As ListObject

Set TBL1 = ActiveSheet.ListObjects("TBL_1")
Set TBL2 = ActiveSheet.ListObjects("TBL_2")
Set TBL3 = ActiveSheet.ListObjects("TBL_3")

Dim ZZ As Long

'we clean TBL3 only if there is data
If Range(TBL3.Name & "[" & TBL3.HeaderRowRange(1, 1).Value & "]").Cells(1, 1).Value <> "" Or _
    Range(TBL3.Name & "[" & TBL3.HeaderRowRange(1, 1).Value & "]").Count > 1 Then TBL3.DataBodyRange.Delete


Range(TBL1.Name & "[" & TBL1.HeaderRowRange(1, 1).Value & "]").Copy
Range(TBL3.Name & "[" & TBL3.HeaderRowRange(1, 1).Value & "]").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False

Range(TBL1.Name & "[" & TBL1.HeaderRowRange(1, 3).Value & "]").Copy
Range(TBL3.Name & "[" & TBL3.HeaderRowRange(1, 3).Value & "]").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False

Range(TBL2.Name & "[" & TBL2.HeaderRowRange(1, 1).Value & "]").Copy

Range(TBL3.Name & "[" & TBL3.HeaderRowRange(1, 1).Value & "]").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False

Range(TBL2.Name & "[" & TBL2.HeaderRowRange(1, 3).Value & "]").Copy

Range(TBL3.Name & "[" & TBL3.HeaderRowRange(1, 3).Value & "]").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False

'we clean blanks
For ZZ = TBL3.DataBodyRange.Rows.Count To 1 Step -1
    If TBL3.DataBodyRange.Cells(ZZ, 1).Value = "" Then TBL3.ListRows(ZZ).Delete
Next ZZ


Set TBL1 = Nothing
Set TBL2 = Nothing
Set TBL3 = Nothing

代码将Tbl1和Tbl2的第1列和第3列中的所有数据粘贴到Tbl3的第1列和第3列中.

The code pastes all data in Column 1 and 3 of Tbl1 and Tbl2 into column 1 and 3 of Tbl3.

粘贴后，它检查是否有空白，如果为true，则删除表的该行.

After pasting, it checks if there is any blank, and if true, then it deletes that row of the table.

我尝试过:

应用代码后，我得到了:

And after applying code, I get this:

请注意，该代码还会在粘贴之前删除TBL3中的所有数据.

希望您可以根据自己的需要对此进行调整.

Hope you can adap this to your needs.

这篇关于粘贴数据-Excel的其他Listobject中Listobject的范围的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！