Диапазон таблиц не изменяется после FilterCopy с расширенным фильтром - PullRequest
Новая
       31

Диапазон таблиц не изменяется после FilterCopy с расширенным фильтром

0 голосов
/ 16 апреля 2020

Я копирую данные, используя Advanced Filter, из одной таблицы рабочих книг в другую таблицу рабочих книг. Копирование работает абсолютно нормально, но выходная таблица не изменяет размер диапазона, чтобы включить новые данные при вводе. Я попробовал приведенный ниже код (и другой код), чтобы заставить таблицу изменить размер диапазона, но он ничего не делает. Он также не выдает ошибку, просто выполняет код.

Это последняя часть кода, которая должна изменить размер таблицы: 

 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, но это тоже ничего не делало. Я буду использовать приведенный выше код для нескольких таблиц, чтобы копировать, а затем изменять размер и изменять каждую неделю. Так что жесткое кодирование значений для изменения размера не вариант.

Переменная myLastRow правильно вычисляет значение (номер последней строки), как и tblFiltered.HeaderRowRange.Count (в данном случае 14).

Не знаю, где я ошибаюсь, если у кого-то есть понимание, это будет полезно, спасибо.

Ответы [ 4 ]

1 голос
/ 16 апреля 2020

Ваша проблема в том, что вы предоставляете Resize метод Table объекта Range объект, который не соответствует ожидаемому

на самом деле, 

.Range(myLastRow, tblFiltered.HeaderRowRange.Count)

фактически извлекает ячейку myLastRow -1 строк и tblFiltered.HeaderRowRange.Count столбцов из первой ячейки ссылочной таблицы ...

Затем вы должны кодировать следующим образом: 

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

который питает метод Resize объекта Table объектом Range, полученным в качестве диапазона заголовка таблицы, на который делаются ссылки, изменившего столько строк, сколько необходимо для достижения вашей строки myLastRow row

0 голосов
/ 16 апреля 2020

Если ваша таблица ограничена (и не содержит) пустых строк / столбцов, вы должны сделать это: 

Dim tbl As ListObject

Set tbl = ActiveSheet.ListObjects("myTable")

tbl.Resize tbl.Range(1).CurrentRegion
0 голосов
/ 16 апреля 2020

DataBodyRange против HeaderRowRange

Название говорит само за себя: HeaderRowRange используется для одной строки заголовков. Вы хотите записать свои данные ниже в DataBodyRange. Первая пустая строка рассчитывается следующим образом:

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

Первый столбец можно рассчитать так: tbl.DataBodyRange.Column.

Таким образом, первая пустая ячейка под таблицей (в 1-м столбце) рассчитывается следующим образом: 

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
0 голосов
/ 16 апреля 2020

Это может помочь, просто показывает, как копировать строки из одной таблицы в другую, добавляя строки во вторую таблицу. 

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, который является только заголовок

...