Table 使用高级过滤器进行 FilterCopy 后范围未调整大小

Table Range not resizing after FilterCopy with Advanced Filter

我正在使用高级筛选器将数据从一个工作簿 table 复制到另一个工作簿 table。复制工作绝对正常,但输出 table 不会调整范围大小以在输入时包含新数据。 我已经尝试了下面的代码(和其他代码)来获取 table 来调整范围,但它没有做任何事情。它也没有给出错误,只是 运行 通过代码。

这是应该调整大小的代码的最后一部分 table:

 With tblFiltered
            .Resize .Range(myLastRow, tblFiltered.HeaderRowRange.Count)
    End With

我包含了更多代码,因此您可以看到变量设置的内容。

'Copy Filtered data to specified tables
Dim tblFiltered As ListObject
Dim copyToRng As Range, SDCRange As Range

'DERANGED
'Store Filtered table in variable
Set tblFiltered = wb.Worksheets("Deranged with SOH").ListObjects("Table_Deranged_with_SOH")

'Remove Filtered table Filters
tblFiltered.AutoFilter.ShowAllData

'Set Copy to range on Filtered sheet table
Set copyToRng = tblFiltered.HeaderRowRange
Set SDCRange = MainWB.Worksheets(2).ListObjects("Table_SDCdata").Range

'Use Advanced Filter
SDCRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=DerangedCrit, CopyToRange:=copyToRng, Unique:=False

'Resize filtered table to include new data
With wb.Worksheets("Deranged with SOH").Cells
        'find last row of source data cell range
        myLastRow = .Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

 End With

With tblFiltered
        .Resize .Range(myLastRow, tblFiltered.HeaderRowRange.Count)
End With

我试过使用 .currentregion,但也没有任何效果。 我将对多个 table 使用上面的代码,每周进行复制,然后调整大小和更改。因此,硬编码调整大小的值不是一种选择。

myLastRow 变量正确计算出一个值(最后一行的编号),tblFiltered.HeaderRowRange.Count(在本例中为 14)也是如此。

不确定我哪里出错了,如果有人有任何见解,那会有所帮助,谢谢。

这可能有帮助,只是展示了如何通过向第二个 table 添加行来将行从一个 table 复制到另一个 table。

Sub x()

Dim t1 As ListObject, t2 As ListObject, r As Range, n As Long

Set t1 = ActiveSheet.ListObjects("Table1")
Set t2 = ActiveSheet.ListObjects("Table2")

Set r = t1.ListRows(4).Range.Resize(2) 'range to be copied, 2 rows to table 1
n = t2.Range.Rows.Count 'initial count of rows in table 2

t2.Resize t2.Range.Resize(t2.Range.Rows.Count + r.Rows.Count) 'resize table2 by number of rows in range to be copied

r.Copy t2.Range.Cells(n + 1, 1) 'copy and paste at original end so should fit

End Sub

不确定您为什么指的是 HeaderRowRange 而它只是 header?

如果您的 table 被空 rows/columns 包围(并且不包含),那么您应该可以这样做:

Dim tbl As ListObject

Set tbl = ActiveSheet.ListObjects("myTable")

tbl.Resize tbl.Range(1).CurrentRegion

DataBodyRange 与 HeaderRowRange

顾名思义:HeaderRowRange 用于 headers 的一行。您想将下面的数据写入 DataBodyRange。第一个空行是这样计算的:

tbl.DataBodyRange.Row + tbl.DataBodyRange.Rows.Count.

第一列可以这样计算:tbl.DataBodyRange.Column

因此 table(第一列)下方的第一个空单元格的计算方式如下:

Cells(tbl.DataBodyRange.Row + tbl.DataBodyRange.Rows.Count, tbl.DataBodyRange.Column)

代码

Sub DBR()

    'Copy Filtered data to specified tables
    Dim tblFiltered As ListObject
    Dim copyToRng As Range, SDCRange As Range

    'DERANGED
    'Store Filtered table in variable
    Set tblFiltered = wb.Worksheets("Deranged with SOH").ListObjects("Table_Deranged_with_SOH")

    'Remove Filtered table Filters
    tblFiltered.AutoFilter.ShowAllData

    'Set Copy to range on Filtered sheet table
    ' '.Parent.Parent' means 'up two levels' i.e. the worksheet.
    ' (first 'level up' is the table)
    With tblFiltered.DataBodyRange
        Set copyToRng = .Parent.Parent.Cells(.Row + .Rows.Count, .Column)
    End With

    Set SDCRange = MainWB.Worksheets(2).ListObjects("Table_SDCdata").Range

    'Use Advanced Filter
    SDCRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=DerangedCrit, CopyToRange:=copyToRng, Unique:=False

End Sub

你的问题是你给 Table object 的 Resize 方法一个 Range object 这不是你所期望的成为

事实上,

.Range(myLastRow, tblFiltered.HeaderRowRange.Count)

实际上是从引用的 table 第一个单元格返回单元格 myLastRow -1 行和 tblFiltered.HeaderRowRange.Count 列 ...

那么,你应该这样编码:

With tbl
    .Resize .HeaderRowRange.Resize(myLastRow - .HeaderRowRange.Rows(1).row + 1)
End With

这是为 Table object 的 Resize 方法提供 Range object 作为引用 table [=31] =] range resized as many rows to reach your myLastRow