gpt4 book ai didi

excel - 将一组值粘贴到 ListObject(Excel 表)上会破坏 Listobject

转载 作者:行者123 更新时间:2023-12-04 20:15:17 27 4
gpt4 key购买 nike

在我的一个工作表中,我有一个

Private Sub BuggingVba()

应该将表中的数据替换为值数组
    Dim MyTable As ListObject, myData() As Variant
Set MyTable = Me.ListObjects(1)
myData = collectMyData ' a function defined somewhere else in my workbook

这可能无关紧要,但在这样做之前, 我调整大小 列表对象(我逐行扩展,因为如果我一次这样做,我会覆盖我的表格下方的内容,而不是对其进行切换。)
    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,我的表/ListObject 不见了! 为什么会发生这种情况,我该如何避免?
End Sub

最佳答案

当我们粘贴整个表格或清除整个表格的内容时,附带的结果是表格对象(ListObject)被删除。这就是当数据逐行更改时代码起作用的原因。

但是,如果我们使用 ListObject 的属性,则不需要逐行进行,甚至不需要插入新行。如下面的代码所示。

在这些过程中,我们假设“目标”Table和“新数据”在同一个 workbook持有代码,位于工作表 12分别:

因为我们将使用 HeaderRowRangeDataBodyRangeListObject那么我们需要获取“新数据”,以同样的方式替换表中的数据。下面的代码将生成两个包含 Header 和 Body Arrays 的数组。

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

然后使用此代码将表中的数据替换为“新数据”
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

关于excel - 将一组值粘贴到 ListObject(Excel 表)上会破坏 Listobject,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/28086597/

27 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com