Расширенный фильтр Excel VBA, чтобы не копировать все столбцы - PullRequest
Новая
       20

Расширенный фильтр Excel VBA, чтобы не копировать все столбцы

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

Я впервые использую AdvancedFilter в VBA. Я пытаюсь скопировать только указанные столбцы c из таблицы исходных данных во внешнюю таблицу рабочей книги. Я видел, как это должно быть указано, когда это делается не в VBA, но это не работает в моем коде.

В настоящее время фильтрация работает и она копируется во внешнюю таблицу книги, НО копирует все заголовки и фильтровал данные, и вставлял все во внешнюю таблицу, а не только в столбцы, которые есть в моей внешней таблице.

Код выполняется без каких-либо сообщений об ошибках.

Итак, я хочу получить результат

  • чтобы не копировать заголовки исходных данных ( SDCRange )
  • Копировать только те столбцы, которые находятся во внешней таблице ( copyToRng )

Текущий код: 

Sub StockManagement(wb As Workbook, ws As Worksheet)
Dim TemplPath As String
Dim SMTemp As String
Dim SMTempF As String  

'Create Filter Criteria ranges
With MainWB.Worksheets.Add
    .Name = "FltrCrit"
    Dim FltrCrit As Worksheet
    Set FltrCrit = MainWB.Worksheets("FltrCrit")
End With

With FltrCrit
    Dim DerangedCrit As Range
    Dim myLastColumn As Long

    'Create Deranged Filter Criteria Range
    .Cells(1, "A") = "Deranged"
    .Cells(2, "A") = "MS"
    .Cells(3, "A") = "<>4"
    .Cells(2, "B") = "SOH"
    .Cells(3, "B") = "=0"

    'get last column, set range name
    With .Cells

        'find last column of data cell range
        myLastColumn = .Find(What:="*", After:=.Cells(2), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column

        'specify cell range
        Set DerangedCrit = .Range(.Cells(2, "A:A"), .Cells(3, myLastColumn))

    End With


'Copy Filtered data to specified tables
Dim tblSDC As ListObject, tblFiltered As ListObject
Dim shSDC As Worksheet, shFiltered As Worksheet
Dim critRange As Range, copyToRng As Range, SDCRange As Range

'Assign values to sheet variables
Set shSDC = MainWB.Worksheets(2)
Set shFiltered = wb.Worksheets("Deranged with SOH")

'Turn off autofilter on filtered tab
shFiltered.AutoFilterMode = False

'Store Filtered table in variable
Set tblFiltered = shFiltered.ListObjects("Table_Deranged_with_SOH")
Set tblSDC = shSDC.ListObjects("Table_SDCdata")

'Remove Filtered table Filters
tblFiltered.AutoFilter.ShowAllData

'Set Criteria range to variable
Set critRange = DerangedCrit

'Set Copy to range on Filtered sheet table
Set copyToRng = tblFiltered.DataBodyRange(1, 1)
Set SDCRange = tblSDC.Range

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

Любая помощь будет оценена.

РЕДАКТИРОВАТЬ:

Если я установите для внешнего / выходного диапазона значение 

Set copyToRng = tblFiltered.HeaderRowRange

Для меня имеет смысл, что он будет вести себя так же, как если бы вы использовали Расширенный фильтр без VBA. Таким образом, вы устанавливаете диапазон выходной таблицы на заголовки диапазона выходной таблицы, и тогда следует просто скопировать все соответствующие столбцы. НО когда я это делаю, ничего не копируется, выходная / внешняя таблица пуста.

Так что любые предложения будут полезны, спасибо.

Ответы [ 2 ]

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

Не проверено, но вы должны быть на правильном пути: 

Sub StockManagement(wb As Workbook, ws As Worksheet)

    Dim FltrCrit As Worksheet
    Dim DerangedCrit As Range
    Dim tblSDC As ListObject, tblFiltered As ListObject
    Dim m As Variant, c As Range


    Set FltrCrit = MainWB.Worksheets.Add()
    With FltrCrit
        .Name = "FltrCrit"
        .Cells(1, "A") = "Deranged"
        .Cells(2, "A") = "MS"
        .Cells(3, "A") = "<>4"
        .Cells(2, "B") = "SOH"
        .Cells(3, "B") = "=0"
        Set DerangedCrit = .Range(.Cells(2, "A"), _
                                  .Cells(2, .Columns.Count).End(xlToLeft)).Resize(2)
    End With

    Set tblFiltered = wb.Worksheets("Deranged with SOH").ListObjects("Table_Deranged_with_SOH")
    tblFiltered.AutoFilter.ShowAllData

    Set tblSDC = MainWB.Worksheets(2).ListObjects("Table_SDCdata")
    tblSDC.Range.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=DerangedCrit

    'loop over the headers in the destination table
    For Each c In tblFiltered.HeaderRowRange.Cells
        m = Application.Match(c.Value, tblSDC.HeaderRowRange, 0) 'matched source header?
        If Not IsError(m) Then
            'got a match - copy visible cells for this column
            tblSDC.ListColumns(c.Value).DataBodyRange.SpecialCells(xlCellTypeVisible).Copy _
                    c.Offset(1, 0)
        End If
    Next c

End Sub
0 голосов
/ 14 апреля 2020

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

Я немного изменил код, чтобы удалить некоторые из переменных (как предложено @Tim Williams) выше.

Код теперь выглядит так: 

Sub StockManagement(wb As Workbook, ws As Worksheet)
Dim TemplPath As String
Dim SMTemp As String
Dim SMTempF As String  

'Create Filter Criteria ranges
With MainWB.Worksheets.Add
    .Name = "FltrCrit"
    Dim FltrCrit As Worksheet
    Set FltrCrit = MainWB.Worksheets("FltrCrit")
End With

With FltrCrit
    Dim DerangedCrit As Range
    Dim myLastColumn As Long

    'Create Deranged Filter Criteria Range
    .Cells(1, "A") = "Deranged"
    .Cells(2, "A") = "MS"
    .Cells(3, "A") = "<>4"
    .Cells(2, "B") = "SOH"
    .Cells(3, "B") = "=0"

    'get last column, set range name
    With .Cells

        'find last column of data cell range
        myLastColumn = .Find(What:="*", After:=.Cells(2), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column

        'specify cell range
        Set DerangedCrit = .Range(.Cells(2, "A:A"), .Cells(3, myLastColumn))

    End With

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

'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
...