VBA - Как ссылаться на столбцы по заголовку в выражении «For»

Question

Я пишу код для динамических, отфильтрованных данных и хочу ссылаться на столбцы по заголовку вместо использования «G», «H» и т. Д. Мой код должен смотреть на ячейку в столбце F (cpass), а затем посмотрите на 5 соседних клеток. Если эти соседние ячейки не заполнены, то вся строка должна быть удалена, а затем она переходит к следующей ячейке в столбце F. Моя проблема заключается в том, что столбцы являются динамическими (извлекаются из отчета) и могут быть неупорядоченными в любой заданной области. день. Я не могу понять, как заставить ссылки на столбцы работать в операторе For. Ниже приведен код, который я пытался написать. Любые предложения будут оценены!

Sub ClassPassDeleteNEWTEST()                                              
Dim cpass As Integer, fmonth As Integer, init As Integer, lmonth As Integer, piftot As Integer, pifnotax As Integer, LR As Long, r As Long
cpass = Application.WorksheetFunction.Match("Class Pass", Range("A1:AZ1"), 0)
fmonth = Application.WorksheetFunction.Match("First Month Only-", Range("A1:AZ1"), 0)
init = Application.WorksheetFunction.Match("InitiationFee", Range("A1:AZ1"), 0)
lmonth = Application.WorksheetFunction.Match("Last Month Only-", Range("A1:AZ1"), 0)
piftot = Application.WorksheetFunction.Match("PIF Total", Range("A1:AZ1"), 0)
pifnotax = Application.WorksheetFunction.Match("PIF Total No Tax", Range("A1:AZ1"), 0)

LR = Cells(Rows.Count, cpass).End(xlUp).Row

For r = LR To 1 Step -1
    If Range(fmonth & r).Value = "" And Range(init & r).Value = "" And _
       Range(lmonth & r).Value = "" And Range(piftot & r).Value = "" And _
       Range(pifnotax & r).Value = "" Then Rows(r).Delete
Next r


 MsgBox ("All Class Passes with no payment have been deleted, and any with a payment have been cleared.")
      ActiveSheet.Range("A:L").AutoFilter Field:=6

End Sub

Answer 1

Вы должны отключить Application.ScreenUpdating и Application.Calculation, чтобы улучшить скорость.

Вот самый простой способ:

Sub ClassPassDeleteNEWTEST()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim cpass As Integer, r As Integer

    cpass = Application.WorksheetFunction.Match("Class Pass", Rows(1), 0)

    For r = Cells(Rows.Count, cpass).End(xlUp).Row To 1 Step -1
        If WorksheetFunction.CountA(Rows(r).Columns("H:L")) = 0 Then Rows(r).Delete
    Next r

    ActiveSheet.Range("A:L").AutoFilter Field:=6

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

    MsgBox ("All Class Passes with no payment have been deleted, and any with a payment have been cleared.")

End Sub

Было бы лучше проверить, существует ли заголовок, и полностью определить диапазоны для целевого рабочего листа.

Sub ClassPassDeleteNEWTEST()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim cpass As Integer, r As Integer
    With ThisWorkbook.Worksheets(1)
        On Error Resume Next
        cpass = Application.WorksheetFunction.Match("Class Pass", .Rows(1), 0)
        If Err.Number <> 0 Then
            MsgBox "Class Pass header was not found", vbCritical, "Action Cancelled"
            Exit Sub
        End If
        On Error GoTo 0

        For r = .Cells(.Rows.Count, cpass).End(xlUp).Row To 1 Step -1
            If WorksheetFunction.CountA(.Rows(r).Columns("H:L")) = 0 Then .Rows(r).Delete
        Next r

        .Range("A:L").AutoFilter Field:=6
    End With

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

    MsgBox ("All Class Passes with no payment have been deleted, and any with a payment have been cleared.")

End Sub

Answer 2

Поскольку совпадение возвращает индекс столбца, используйте Cells ссылки вместо Range ссылок. Вы рассматриваете диапазон заголовков A1:AZ1, поэтому результатом совпадения будет индекс столбца.

Измените Range(fmonth & r) на Cells(r, fmonth) и т. Д.