Код Excel VBA для фильтрации двух столбцов и извлечения данных

Question

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

Вот Micro_Enabled_Excel_File , который я использую.

У меня есть файл Excel с несколькими столбцами и строками. Количество строк будет увеличиваться с течением времени. Я пытаюсь отфильтровать два столбца, скопировать последнюю / последнюю точку данных (строку) и вставить ее на новый лист для создания отчета о состоянии.

Набор данных Excel: изображение

Как будут выглядеть результаты: image

Что я сделал до сих пор:

1. Создание Micro для go через столбцы " SCOPE "и" TRADE NAME ", чтобы получить уникальные записи и скопировать их на другой лист, который называется" Код ".

Sub First_COPY_STYLE_TO_REPORT()

    'creating the Report sheet
    Sheets("Report").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    Sheets("Status Updates").Select
    Cells.Select
    Selection.Copy
    Sheets("Report").Select
    ActiveSheet.Paste
    Rows("2:1048576").Select
    Application.CutCopyMode = False
    Selection.ClearContents

End Sub

Создан Micro для создания шаблона для листа «Отчет», который в итоге будет заполнен результатами следующего Micro.

Sub Second_COPY_UNIQUE_TO_CODE()

'add title to filter columns in the Code sheet
    Sheets("Code").Select
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Filter1"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Filter2"

'creating the filter criteria also known as scope and trade name

    'Finds Duplicates on SCOPE column and copies it to a new sheet called CODE
    Sheets("Status Updates").Select
    Dim s1 As Worksheet, s2 As Worksheet
    Set s1 = Sheets("Status Updates")
    Set s2 = Sheets("Code")
    s1.Range(Range("B2"), Range("B2").End(xlDown)).Copy s2.Range("A2")
    s2.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo

    'Finds Duplicates on NAME column and copies it to a new sheet called CODE
    Dim s3 As Worksheet, s4 As Worksheet
    Set s3 = Sheets("Status Updates")
    Set s4 = Sheets("Code")
    s1.Range(Range("C2"), Range("C2").End(xlDown)).Copy s2.Range("B2")
    s4.Range("B:B").RemoveDuplicates Columns:=1, Header:=xlNo

    'Clears formating and autofits column widths
    Sheets("Code").Cells.ClearFormats
    ThisWorkbook.Worksheets("Code").Cells.EntireColumn.AutoFit

End Sub

Создан Micro (не функционирующий), который включает в себя два цикла для фильтрации двух столбцов, сортировки первого столбца, копирования и вставки второй строки листа в лист «Отчет».

Sub Third_Generate_Latest_Status_Report()

    Dim a1 As Long, a2 As Long, b1 As Long, b2 As Long
        a1 = Cells.Find("Filter1").Offset(1, 0).Row
        a2 = Cells.Find("Filter1").End(xlDown).Row
        b1 = Cells.Find("Filter2").Offset(1, 0).Row
        b2 = Cells.Find("Filter2").End(xlDown).Row

    Dim g As Long, i As Long

    For g = a1 To a2 'Look up for Filter1 column. Then loop through all criterias.
        ActiveSheet.Range("$C$1:$J$300").AutoFilter Field:=2, Criteria1:=g
        For i = b1 To b2 'Look up for Filter2 column. Then loop through all criterias.
            ActiveSheet.Range("$C$1:$J$300").AutoFilter Field:=3, Criteria1:=i

            'sort the NO column from largest to smallest (to get the latest/most recent update).
            'I have copied this part of the code from the Micro I recorded.
            ActiveWorkbook.Worksheets("Status Updates").AutoFilter.Sort.SortFields.Clear
            ActiveWorkbook.Worksheets("Status Updates").AutoFilter.Sort.SortFields.Add2 _
                Key:=Range("C1:C300"), SortOn:=xlSortOnValues, Order:=xlDescending, _
                DataOption:=xlSortNormal
            With ActiveWorkbook.Worksheets("Status Updates").AutoFilter.Sort
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
                'I think I need to add code here to copy the row to sheet Report, and run the loop again
            End With
        Next i 'take next value in column Filter2
    Next g 'take next value in column Filter1
End Sub

Что мне нужно:

1. Лист «Обновления статуса» - отфильтруйте столбец «ОБЛАСТЬ» и выполните все критерии. Затем,
2. Лист «Обновления статуса» - Фильтр » TRADE NAME "и выполните все критерии.
3. Сортируйте столбец" NO ", чтобы получить самую последнюю точку данных.
4. Скопируйте первую строку данных (то есть первую строку после заголовков). )
5. Вставьте его в другой лист под названием «Отчет».

Не могли бы вы взглянуть на мой код и сообщить мне, в чем мои ошибки?

Это мой первый раз код / ​​программирование / использование VBA.

Answer 1

Наличие дополнительного листа «кода», как правило, просто усложняет задачу. А поскольку ваш лист «Обновления статуса» уже отсортирован по самым старым обновлениям к самым новым обновлениям, мы знаем, что для любой конкретной уникальной комбинации вам всегда понадобится обновление снизу. Мы можем гарантировать, что если мы переместим ваши данные * oop назад (из нижнего ряда в первый ряд, это то, что делает Step -1).

Затем используйте словарь для проверки уникальных комбинаций и извлеките первая встреченная строка (помните, что мы возвращаемся назад, поэтому первая встреченная строка будет последним обновлением) для каждой уникальной комбинации и скопируйте эти строки на лист отчета.

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

Sub tgr()

    'Declare and set workbook and worksheet object variables
    Dim wb As Workbook:         Set wb = ActiveWorkbook
    Dim wsUpdt As Worksheet:    Set wsUpdt = wb.Worksheets("Status updates")
    Dim wsRprt As Worksheet:    Set wsRprt = wb.Worksheets("Report")

    'Declare and set a range variable that contains your data
    Dim rUpdateData As Range:   Set rUpdateData = wsUpdt.Range("A2:G" & wsUpdt.Cells(wsUpdt.Rows.Count, "A").End(xlUp).Row)

    'Verify data actually exists
    If rUpdateData.Row < 2 Then Exit Sub    'If the beginning row is the header row, then no data actually exists

    'Use a dictionary object to keep track of unique Scope and Trade Name combos
    Dim hUnqScopeTrades As Object:  Set hUnqScopeTrades = CreateObject("Scripting.Dictionary")

    'Declare your resulting Copy Range variable. This will be used to gather only the range of rows that will be copied over to the Report worksheet
    Dim rCopy As Range

    'Declare a looping variable
    Dim i As Long

    'Loop through each row in your Status Updates data.  Because your updates are already sorted Oldest to Newest, begin at the end and loop backwards to guarantee newest updates are found first
    For i = rUpdateData.Rows.Count To 1 Step -1
        'Verify this Scope/Trade combo hasn't been seen before
        If Not hUnqScopeTrades.Exists(rUpdateData.Cells(i, 2).Value & "|" & rUpdateData.Cells(i, 3).Value) Then
            'This is a newly encountered unique combo
            'Add the combo to the dictionary
            hUnqScopeTrades(rUpdateData.Cells(i, 2).Value & "|" & rUpdateData.Cells(i, 3).Value) = i

            'If this is the first unique combo found, rCopy will be empty, check if that's the case
            If rCopy Is Nothing Then
                'rCopy is empty, add the first found unique combo to it
                Set rCopy = rUpdateData.Cells(i, 1)
            Else
                'rCopy is not empty, add all additional unique combos with the Union method
                Set rCopy = Union(rCopy, rUpdateData.Cells(i, 1))
            End If
        End If
    Next i

    'Clear previous results (if any)
    wsRprt.Range("A1").CurrentRegion.Offset(1).Clear

    'Verify rCopy isn't empty and then copy all rows over
    If Not rCopy Is Nothing Then rCopy.EntireRow.Copy wsRprt.Range("A2")

End Sub