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

Question

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

Вот фрагмент моего кода:

Sub()
    Dim Workbook1 As Workbok
    Dim count As Long

    count = 0
    For i = 1 To 20
        Select Case IsEmpty(Workbook1.Worksheets("WorksheetNumber" & i).Cells(1,1))
            Case True
                count = count + 1
        End Select
    Next i
    MsgBox(count)

    count = 0
    For i = 1 To 20
        Select Case Application.CountA(Workbook1.Worksheets("WorksheetNumber" & i).Range("$C$3:$E$5"))>0
            Case True
                count = count + 1
        End Select
    Next i
    MsgBox(count)

End Sub

У меня повторяется еще много таких циклов, за исключением того, что критерии отличаются. Итак, как видите, структура кода для каждого из циклов одинакова, но критерии Select Case изменены. Как я могу сократить свой очень длинный код?

Я пытался создать функцию, которая делает переменные критериев Select Case переменными, но кажется, что она не работает, потому что критерии оцениваются до того, как они входят в функцию.

Вот что у меня есть:

Function f_1(Criteria As Variant, Workbook1) As Long
    f_1 = 0
    For i = 1 To 20
        Select Case Criteria
            Case True
                f_1 = Application.Sum(f_1, 1)
        End Select
    Next i
End Function

А вот подпрограмма, которая пытается вызвать функцию:

Sub(Workbook1 As Workbook)
    Dim count As Long

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

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

Что происходит, так это утверждение

IsEmpty(Workbook1.Worksheets("WorksheetNumber" & i).Cells(1,1))

и утверждение

Application.CountA(Workbook1.Worksheets("WorksheetNumber" & i).Range("$C$3:$E$5"))>0

оценивается перед отправкой в ​​функцию, поэтому, в зависимости от значения i , один рабочий лист оценивается 20 раз (если i окажется между 1 и 20 включительно), или индекс находится вне диапазона (если i не между 1 и 20 включительно).

Я попросил помощи, и кто-то предложил создать объекты; Я немного погуглил, но я не совсем уверен, как это мне поможет, поэтому, если кто-нибудь сможет помочь мне уточнить мои поисковые термины, это тоже будет здорово!

Спасибо большое!

Answer 1

Где я вижу повторение - это структура цикла.Я бы использовал такой код с однострочными условными выражениями, если не важно, какое условие увеличивает переменную счетчика.Вы можете добавить столько условий, сколько хотите, и код остается относительно плоским.Между прочим, хорошо использовать «явную опцию».В первой строке Workbook есть опечатка "Workbok"

Option Explicit

Sub test()
Dim workbook1 As Workbook
Set workbook1 = ThisWorkbook
Dim i As Long, count As Long
For i = 1 To Worksheets.count
    If IsEmpty(workbook1.Worksheets("Sheet" & i).Cells(1, 1)) Then count = count + 1
    If Application.CountA(workbook1.Worksheets("Sheet" & i).Range("$C$3:$E$5")) > 0 Then count = count + 1
Next i
End Sub

EDIT:
Вместо того, чтобы использовать разные переменные подсчета, как вы прокомментировали, я бы предпочел, чтобы все счетчики условий были связаны водно место.Это можно сделать с помощью массива или словаря.

Использование массива:

Option Explicit

Sub UseOfArray()
Dim workbook1 As Workbook
Set workbook1 = ThisWorkbook
Dim i As Long
Dim conditions_in_array(1 To 20) As Long

For i = 1 To Worksheets.count
    If IsEmpty(workbook1.Worksheets("Sheet" & i).Cells(1, 1)) Then conditions_in_array(1) = conditions_in_array(1) + 1
    If workbook1.Worksheets("Sheet" & i).Cells(1, 1).Interior.Color = 16777215 Then conditions_in_array(2) = conditions_in_array(2) + 1
Next i
Debug.Print "conditions_in_array(1): "; conditions_in_array(1); vbNewLine; "conditions_in_array(2): "; conditions_in_array(2)

End Sub

Использование словаря (я бы предпочел такой подход, так как при большем количестве условий его легче отлаживать):

Sub UseOfDictionary()
Dim i As Long
Dim workbook1 As Workbook
Set workbook1 = ThisWorkbook
Dim conditions_in_dict As Scripting.Dictionary
Set conditions_in_dict = New Scripting.Dictionary
conditions_in_dict("cell_IsEmpty") = 0
conditions_in_dict("cell_uncolored") = 0
'here you can enter more keys as conditions as above

For i = 1 To Worksheets.count
    If IsEmpty(workbook1.Worksheets("Sheet" & i).Cells(1, 1)) Then conditions_in_dict("cell_IsEmpty") = conditions_in_dict("cell_IsEmpty") + 1
    If workbook1.Worksheets("Sheet" & i).Cells(1, 1).Interior.Color = 16777215 Then conditions_in_dict("cell_uncolored") = conditions_in_dict("cell_uncolored") + 1
Next i
Debug.Print "conditions_in_dict(""cell_IsEmpty""): "; conditions_in_dict("cell_IsEmpty"); vbNewLine; _
"conditions_in_dict(""cell_uncolored""): "; conditions_in_dict("cell_uncolored")

End Sub