Подмножество автофильтра VBA содержит дополнительную строку вверх - PullRequest
0 голосов
/ 07 февраля 2019

Макрос пытается отфильтровать лист «Temp» по одному критерию за раз (PE, AR, DC, FI) и скопировать столбец 5, содержащий неповторяющиеся данные, в другой лист «Detail».Пожалуйста, помогите мне понять две проблемы.(1) Макрос корректирует фильтрацию для каждого из 4 критериев.Однако отфильтрованный список для каждого из критериев всегда содержит первый элемент из отфильтрованного списка самых первых критериев «PE».То есть отфильтрованный список для критерия 2 «AR» содержит все элементы в AR, но начинается с первого элемента в «PE».Есть строка заголовка, но это, кажется, не имеет значения.Как я могу избавиться от этого первого элемента во всех случаях, кроме случаев фильтрации по «PE» (где он принадлежит)?(2) Я хотел бы иметь возможность подсчитывать и хранить количество видимых строк для каждого отфильтрованного списка.Я хотел бы иметь возможность вставлять каждый отфильтрованный список в другую электронную таблицу («Подробно»), начиная с ячейки A4.Каждый последовательный список должен начинаться на две строки ниже только что вставленного списка.Например, если первый список содержит 16 элементов, следующий список должен начинаться в ячейке A22 (A4 + 16 + 2).По какой-то причине функция copiedrows (используется для запоминания количества строк в отфильтрованном списке) верна в первый раз (= 16), но не во второй раз (= 1?).Похоже, что 1 и 2 q связаны между собой.Возможно, если я выясню # 1, я могу что-то сделать с # 2.Я просмотрел последние публикации по автофильтрации, но все еще чувствую себя немного застрявшим здесь.Очень ценю вашу помощь!

Sub FilterCategories()

Dim LastRow As Long
Dim startpos As Integer
Dim k As Integer
Dim copiedrows(1 To 4) As Long
Dim AG(1 To 4) As String
Dim rng As Range


AG(1) = "PE"
AG(2) = "AR"
AG(3) = "DC" 
AG(4) = "FI"

'Autofilter based on each AG and copy over to 'Detail'. Create temporary 
 sheet for filtering.


 startpos = 4

        For k = LBound(AG) To UBound(AG)

        Application.DisplayAlerts = False
        On Error Resume Next
        Sheets("Temp").Delete
        Sheets("Lookup").AutoFilterMode = False
        Sheets("Lookup").Copy After:=Sheets("Lookup")
        ActiveSheet.Name = "Temp"

        With Sheets("Temp")
        AutoFilterMode = False

        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row  


                With .Range("A2:E" & LastRow)

                    .AutoFilter Field:=4, Criteria1:=AG(k)

                    .RemoveDuplicates Columns:=5

                    .Columns(5).SpecialCells(xlCellTypeVisible).Copy 
Destination:=Sheets("Detail").Range("A" & startpos)

                    copiedrows(k) = .SpecialCells(xlCellTypeVisible).Rows.Count

                    Debug.Print copiedrows(k)

                    startpos = copiedrows(k) + 6

                    Debug.Print startpos


                End With


          End With

          Next


End Sub
...