将值数组粘贴到 ListObject (Excel table) 上会破坏 Listobject
Pasting an array of values over a ListObject (Excel table) destroys the Listobject
在我的一张工作表中,我有一个
Private Sub BuggingVba()
应该将 table 中的数据替换为值数组
Dim MyTable As ListObject, myData() As Variant
Set MyTable = Me.ListObjects(1)
myData = collectMyData ' a function defined somewhere else in my workbook
这可能是无关紧要的,但在这样做之前,我调整列表对象的大小(我逐行扩展,因为如果我立即这样做,我覆盖我的 table 下面的内容而不是转移它。)
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 required Then
Dim FullTableRange As Range
Set FullTableRange = MyTable.HeaderRowRange _
.Resize(1 + required, MyTable.HeaderRowRange.Columns.Count)
FullTableRange.Value = sourceData
End If
还有 BAM,我的 table/ListObject 不见了! 为什么会发生这种情况,我该如何避免?
End Sub
当我们粘贴整个 table 或清除整个 table 的内容时,附带的结果是 table 对象 (ListObject
) 被删除。这就是当数据逐行更改时代码起作用的原因。
但是,如果我们使用 ListObject
的属性,则不需要逐行执行,甚至不需要插入新行,如下面的代码所示。
在这些过程中,我们假设 "Target" Table
和 “新数据” 是,在同一 workbook
中保存代码,分别位于工作表 1
和 2
中:
因为我们将使用HeaderRowRange
和ListObject
的DataBodyRange
,所以我们需要获取“新数据”来替换[=39=中的数据] 以相同的方式。下面的代码将生成两个数组,其中包含 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
然后使用此代码将table中的数据替换为"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
旧 post,但我粘贴到列表对象 table 的方法是删除数据体范围,将范围设置为数组大小,然后将范围设置为数组。类似于上面提供的解决方案,但不需要调整 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
在我的一张工作表中,我有一个
Private Sub BuggingVba()
应该将 table 中的数据替换为值数组
Dim MyTable As ListObject, myData() As Variant
Set MyTable = Me.ListObjects(1)
myData = collectMyData ' a function defined somewhere else in my workbook
这可能是无关紧要的,但在这样做之前,我调整列表对象的大小(我逐行扩展,因为如果我立即这样做,我覆盖我的 table 下面的内容而不是转移它。)
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 required Then
Dim FullTableRange As Range
Set FullTableRange = MyTable.HeaderRowRange _
.Resize(1 + required, MyTable.HeaderRowRange.Columns.Count)
FullTableRange.Value = sourceData
End If
还有 BAM,我的 table/ListObject 不见了! 为什么会发生这种情况,我该如何避免?
End Sub
当我们粘贴整个 table 或清除整个 table 的内容时,附带的结果是 table 对象 (ListObject
) 被删除。这就是当数据逐行更改时代码起作用的原因。
但是,如果我们使用 ListObject
的属性,则不需要逐行执行,甚至不需要插入新行,如下面的代码所示。
在这些过程中,我们假设 "Target" Table
和 “新数据” 是,在同一 workbook
中保存代码,分别位于工作表 1
和 2
中:
因为我们将使用HeaderRowRange
和ListObject
的DataBodyRange
,所以我们需要获取“新数据”来替换[=39=中的数据] 以相同的方式。下面的代码将生成两个数组,其中包含 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
然后使用此代码将table中的数据替换为"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
旧 post,但我粘贴到列表对象 table 的方法是删除数据体范围,将范围设置为数组大小,然后将范围设置为数组。类似于上面提供的解决方案,但不需要调整 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