vba 在 ListObject（Excel 表格）上粘贴一组值会破坏 Listobject
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/28086597/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Pasting an array of values over a ListObject (Excel table) destroys the Listobject
提问by Dirk Horsten
In one of my worksheets, I have a
在我的一张工作表中，我有一个
Private Sub BuggingVba()
That should replace the data in a table with an array of values
这应该用一组值替换表中的数据
Dim MyTable As ListObject, myData() As Variant
Set MyTable = Me.ListObjects(1)
myData = collectMyData ' a function defined somewhere else in my workbook
It is probably irrelevant, but before doing so, I resizethe list object (I expand line by line because if I do it at once, I overwrite what is below my table instead of schifting it.)
这可能无关紧要，但在此之前，我调整了列表对象的大小（我逐行展开，因为如果我立即执行此操作，我会覆盖表格下方的内容，而不是将其拆分。）
Dim current As Integer, required As Integer, saldo As Integer
current = MyTable.DataBodyRange.Rows.Count
required = UBound(sourceData, 1) - LBound(sourceData, 1)
' current and required are size of the body, excluding the header
saldo = required - current
If required < current Then
' reduce size
Range(DestinBody.Rows(1), DestinBody.Rows(current - required)).Delete xlShiftUp
Else
' expland size
DestinBody.Rows(1).Copy
For current = current To required - 1
DestinBody.Rows(2).Insert xlShiftDown
Next saldo
End If
If there is any data to insert, I overwrite the values
如果有任何数据要插入，我会覆盖这些值
If required Then
Dim FullTableRange As Range
Set FullTableRange = MyTable.HeaderRowRange _
.Resize(1 + required, MyTable.HeaderRowRange.Columns.Count)
FullTableRange.Value = sourceData
End If
And BAM, my table/ListObject is gone!Why does this happen and how can I avoid it?
和 BAM，我的表/ListObject 不见了！为什么会发生这种情况，我该如何避免？
End Sub
回答by EEM
When we paste over the entire table or clear the contents of the entire table the collateral result is that the table object (ListObject) is deleted. That's the reason the code works when the data is changed row by row.
当我们粘贴整个表或清除整个表的内容时，附带的结果是表对象 ( ListObject) 被删除。这就是代码在逐行更改数据时起作用的原因。
However, there is no need to do it row by row, not even the insertion of new rows if we work with the properties of the ListObjectas demonstrated in the code below.
但是，如果我们使用ListObject下面代码中演示的属性，则不需要逐行进行，甚至不需要插入新行。
In these procedures we assumed that the "Target"Tableand the “New Data”are, in the same workbookholding the code, located at worksheets 1and 2respectively:
在这些过程中，我们假设“目标”Table和“新数据”在同workbook一个代码中，分别位于工作表1和2：
As we will work with the HeaderRowRangeand the DataBodyRangeof the ListObjectthen we need to obtain the “New Data” to replace the data in the table in the same manner. The code below will generate two arrays with the Header and Body Arrays.
由于我们将使用HeaderRowRange和DataBodyRange，ListObject然后我们需要以相同的方式获取“新数据”以替换表中的数据。下面的代码将生成两个带有 Header 和 Body 数组的数组。
Sub Dta_Array_Set(vDtaHdr() As Variant, vDtaBdy() As Variant)
Dim vArray As Variant
With ThisWorkbook.Worksheets("Sht(1)").Range("DATA") 'Change as required
vArray = .Rows(1)
vDtaHdr = vArray
vArray = .Offset(1, 0).Resize(-1 + .Rows.Count)
vDtaBdy = vArray
End With
End Sub
Then use this code to replace the data in the table with the "New Data"
然后使用此代码将表中的数据替换为“新数据”
Private Sub ListObject_ReplaceData()
Dim MyTable As ListObject
Dim vDtaHdr() As Variant, vDtaBdy() As Variant
Dim lRowsAdj As Long
Set MyTable = ThisWorkbook.Worksheets(1).ListObjects(1) 'Change as required
Call Data_Array_Set(vDtaHdr, vDtaBdy)
With MyTable.DataBodyRange
Rem Get Number of Rows to Adjust
lRowsAdj = 1 + UBound(vDtaBdy, 1) - LBound(vDtaBdy, 1) - .Rows.Count
Rem Resize ListObject
If lRowsAdj < 0 Then
Rem Delete Rows
.Rows(1).Resize(Abs(lRowsAdj)).Delete xlShiftUp
ElseIf lRowsAdj > 0 Then
Rem Insert Rows
.Rows(1).Resize(lRowsAdj).Insert Shift:=xlDown
End If: End With
Rem Overwrite Table with New Data
MyTable.HeaderRowRange.Value = vDtaHdr
MyTable.DataBodyRange.Value = vDtaBdy
End Sub
回答by JR97
Old post, but the way I paste over a listobject table is to delete the databodyrange, set a range to the array size and then set the range to the array. Similar to the solution provided above, but doesn't require resizing the table.
旧帖子，但我粘贴到列表对象表的方法是删除数据主体范围，将范围设置为数组大小，然后将范围设置为数组。类似于上面提供的解决方案，但不需要调整表格的大小。
'Delete the rows in the table
If lo.ListRows.Count > 0 Then
lo.DataBodyRange.Delete
End If
'Assign the range to the array size then assign the array values to the range
Set rTarget = wsTemplate.Range("A2:K" & UBound(arrTarget) + 1)
rTarget = arrTarget
