VBA удаляет строку через поиск и среднее

Question

У меня есть таблица, которая меняется ежедневно. Время от времени текст "AB12" находится в столбце A, кратном трем. Когда это происходит, мне нужно VBA, чтобы распознать, что это произошло, найти строку, в которой он произошел, а затем усреднить значения в столбцах C, E, G, I, K, M, O и Q в этой строке. Затем это среднее необходимо сравнить со средним для следующей строки и строки после нее, удалив все, кроме строки с самым высоким средним значением.

Код, который я написал до сих пор, найден ниже.

Sub FindAB12()
    Columns("A:Q").Select
    Set rngRange = Selection.CurrentRegion
    lngNumRows = rngRange.Rows.Count
    lngFirstRow = rngRange.Row
    lngLastRow = lngFirstRow + lngNumRows - 1
    lngCompareColumn = ActiveCell.Column
    For lngCurrentRow = lngLastRow To lngFirstRow Step -1
        If (Cells(lngCurrentRow, lngCompareColumn).Text = "AB12" And Cells(lngCurrentRow + 1, lngCompareColumn).Text = "AB12") Then _
            AB121 = Application.WorksheetFunction.Average(Sheet1.Range("C" & lngCurrentRow & ":Q" & lngCurrentRow))
            AB122 = Application.WorksheetFunction.Average(Sheet1.Range("C" & (lngCurrentRow + 1) & ":Q" & (lngCurrentRow + 1)))
            AB123 = Application.WorksheetFunction.Average(Sheet1.Range("C" & (lngCurrentRow + 2) & ":Q" & (lngCurrentRow + 2)))
        Next lngCurrentRow

        If AB1211 > AB122 And AB1211 > AB123 Then
            Rows(lngCurrentRow + 1 And lngCurrentRow + 2).Delete
        ElseIf AB122 > AB123 And AB122 > AB121 Then
            Rows(lngCurrentRow And lngCurrentRow + 2).Delete
        ElseIf AB123 > AB122 And AB123 > AB121 Then
            Rows(lngCurrentRow And lngCurrentRow + 1).Delete
        End If
    End Sub

В отдельном модуле у меня есть подпрограмма, вызываемая при открытии вкладки. Можно ожидать, что при открытии этой вкладки в последовательных строках будет существовать только одна строка с именем AB12 (хотя в более позднем ряду может существовать еще одна AB12). Код работает до тех пор, пока я не попытаюсь усреднить (я использовал тот же код, чтобы успешно найти и удалить эти дублированные строки, когда вычисления не были нужны). Когда он играет и достигает второй средней функции, я получаю ошибку "Run-time error '1004': Method 'Range' of object '_Worksheet' failed. Я довольно новичок в VBA, и после просмотра большого количества кода, созданного другими, я не смог решить эту проблему. Я надеюсь, что кто-то там может помочь. Я никогда раньше не пользовался этим форумом и не уверен, как лучше загрузить свой текущий код, надеюсь, что моя проблема и текущий код ясны.

Answer 1

Я попытался очистить это для вас здесь - я удалил некоторые ненужные переменные, удалил Select/ActiveColumn и исправил некоторые опечатки, которые у вас были (их легко было найти с помощью Option Explicit):

Option Explicit
Sub FindAB12()

    Dim lngLastRow As Long, lngCompareColumn As Long, lngCurrentRow As Long
    Dim AB121 As Long, AB122 As Long, AB123 As Long

    lngCompareColumn = 1 'Column A
    lngLastRow = Cells(Rows.Count, lngCompareColumn).End(xlUp).Row

    For lngCurrentRow = lngLastRow To 2 Step -1

        If Cells(lngCurrentRow, lngCompareColumn).Value = "AB12" And _
           Cells(lngCurrentRow + 1, lngCompareColumn).Value = "AB12" And _
           Cells(lngCurrentRow + 2, lngCompareColumn).Value = "AB12" Then
            AB121 = Application.WorksheetFunction.Average(Sheet1.Range("C" & lngCurrentRow & ":Q" & lngCurrentRow))
            AB122 = Application.WorksheetFunction.Average(Sheet1.Range("C" & lngCurrentRow + 1 & ":Q" & lngCurrentRow + 1))
            AB123 = Application.WorksheetFunction.Average(Sheet1.Range("C" & lngCurrentRow + 2 & ":R" & lngCurrentRow + 2))

            If AB121 >= AB122 And AB121 >= AB123 Then
                Rows(lngCurrentRow + 2).Delete
                Rows(lngCurrentRow + 1).Delete
            ElseIf AB122 >= AB123 And AB122 >= AB121 Then
                Rows(lngCurrentRow + 2).Delete
                Rows(lngCurrentRow).Delete
            ElseIf AB123 >= AB122 And AB123 >= AB121 Then
                Rows(lngCurrentRow + 1).Delete
                Rows(lngCurrentRow).Delete
            End If

        End If

    Next lngCurrentRow

End Sub