Как я могу создать цикл с переменными критериями / условием?

Question

У меня есть функция, которая перебирает листы X, чтобы подсчитать, сколько из них соответствует определенным критериям, но я хочу, чтобы этот критерий был переменным.

Это мой код функции:

Function f_1(Condition As Variant, Condition_TrueFalse As Boolean, i_Start As Long, i_End As Long) As Long
    f_1 = 0
    For i = i_Start To i_End
        Select Case Condition
            Case Condition_TrueFalse
                f_1 = Application.Sum(f_1, 1)
        End Select
    Next i
End Function

У меня есть рабочая книга с 20 листами с именами "WorksheetNumber1", "WorksheetNumber2", "WorksheetNumber3", "WorksheetNumber4", ..., "WorksheetNumber20".

Так, например, яможет иметь эту подпрограмму:

Sub(Workbook1 As Workbook)
    Dim count As Long

    'example A
    count = f_1(IsEmpty(Workbook1.Worksheets("WorksheetNumber" & i).Cell(1,1)),False,1,10)
    MsgBox(count)

    'example B
    count = f_1(Application.CountA(Workbook1.Worksheets("WorksheetNumber" & i).Range("$C$3:$E$5"))>0,True,1,5)
    MsgBox(count)
End Sub

У меня есть несколько из этих критериев, поэтому я действительно не хочу повторять код;так как структура кода похожа, я подумал, что смогу сделать критерии переменными.

То, что я хочу:

• Для примера A, если cell (1,1) не является пустым для WorksheetNumber i (для i = 1-10), тогда f_1 увеличивается на единицу;окончательное значение для f_1 возвращается и присваивается переменной 'count';и затем отображается 'count'.
• Для примера B, если число непустых ячеек в диапазоне $ C $ 3: $ E $ 5 больше 0 для WorksheetNumber i (дляя = 1 к 5), то f_1 увеличивается на единицу;окончательное значение для f_1 возвращается и присваивается переменной 'count';и затем отображается 'count'.

В настоящее время я сталкиваюсь с ошибкой "Subscript Out of Range" в строках кода "count = ...", которые яугадывание происходит из-за «я» в рабочих листах («SheetNumber» и я).Как я могу заняться кодированием для достижения желаемых результатов?

Большое вам спасибо!

Answer 1

Если все ваши тесты можно выразить в виде формул рабочего листа, то вы можете сделать что-то вроде этого:

Sub tester()

    Debug.Print CountIt(ThisWorkbook, "A1<>""""", 1, 5)

    Debug.Print CountIt(ThisWorkbook, "COUNTA(C3:E5)>0", 1, 5)

    Debug.Print CountIt(ThisWorkbook, "CountRedFont(B3:B5)", 1, 5)

End Sub

Function CountIt(wb As Workbook, theTest As String, _
                fromSheet As Long, toSheet As Long) As Long
    Dim n As Long, i As Long
    For i = fromSheet To toSheet
        n = n + IIf(wb.Sheets(i).Evaluate(theTest), 1, 0)
    Next i
    CountIt = n
End Function

'test UDF
Function CountRedFont(rng As Range)
    Dim c As Range, n As Long
    For Each c In rng.Cells
        If c.Font.Color = vbRed Then n = n + 1
    Next c
    CountRedFont = n
End Function