VBA: Как для каждого цикла с множественными If, остальными условиями и формулами на основе динамических критериев?

Question

У меня есть макрос, который вычисляет значения в диапазоне в зависимости от их существования. Если все существует, тогда выполните определенный расчет, иначе он проходит через различные условия и рассчитывает в соответствии с тем, что существует. Я до сих пор в состоянии заставить его вычислить, существуют ли все значения, но нет изменений некоторых несуществующих. Будем очень благодарны любой помощи. (см. код ниже)

Private Sub example()

    Dim ws As Worksheet
    Dim s As Range
    Dim lastcol as Long
    Dim lastrow as Long
    Dim h1 As Variant
    Dim a As String
    Dim b As String
    Dim c As String
    Dim d As String
    Dim e As String

    lastcol = ws.Cells(4, Columns.Count).End(xlToLeft).Column
    lastrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    On Error Resume Next

    h1 = ws.Range("A4:Z4").Find("Header1").Offset(1, 0).Address(False, False)
    'h2 to h6 - same as above

    a = "Header1"
    b = "Header2"
    c = "Header3"
    d = "Header4"
    e = "Header5"

    ws.Range(Range("A4:Z4").Find("Header0").Offset(0, 1), Range("A4:Z4").Find("Header6").Offset(0, -1)).Select
    With Selection
    For Each s In Selection

            'Calc (Header1, Header2, Header3, Header4, Header5) - ALL
    If s.Value.a = True And s.Value.b = True And s.Value.c = True And s.Value.d = True And s.Value.e = True Then
    ws.Range(Range("A4:Z4").Find("Result %").Offset(1, 0), Cells(lastrow, lastcol)).Formula = _
"=IFERROR(SUM(" & h1 & "," & h2 & "," & h3 & "," & h4 & ", If(" & h5 & "/" & h6 & ">1%," & h6 & "*1%," & h5 & "))/ " & h6 & ", """") "

        'Calc (Header1, Header2, Header3, Header4) - NO Header5
    ElseIf s.Value.a = True And s.Value.b = True And s.Value.c = True And s.Value.d = True And s.Value.e = False Then
    ws.Range(Range("A4:Z4").Find("Result %").Offset(1, 0), Cells(lastrow, lastcol)).Formula = _
"=IFERROR(SUM(" & h1 & "," & h2 & "," & h3 & "," & h4 & ")/" & h6 & ", """") "

        'Calc (Header1, Header2, Header3, Header5) - NO Header4
    ElseIf s.Value.a = True And s.Value.b = True And s.Value.c = True And s.Value.d = False And s.Value.e = True Then
    ws.Range(Range("A4:Z4").Find("Result %").Offset(1, 0), Cells(lastrow, lastcol)).Formula = _
"=IFERROR(SUM(" & h1 & "," & h2 & "," & h3 & ", IF(" & h5 & "/" & h6 & ">1%," & h6 & "*1%," & h5 & "))/" & h6 & ", """") "
    ' Total of 15 conditions and formulas

    End If
    Next
    End With
End Sub

Answer 1

Ваши формулы довольно сложные. Я не уверен, правильно ли я понимаю, что вам нужно, но я написал и протестировал этот код. По крайней мере, он должен дать вам представление о том, что вы можете сделать, чтобы ваш макрос работал.

Sub CreateDynamicFormula()

    Dim strList(1 To 5) As String
    Dim r As Range
    Dim s As Variant
    Dim counter As Long

    Const h1 As String = "Header1"
    Const h2 As String = "Header2"

    counter = 1

    'This is the inner loop
    'finds which columns meet your condition and adds them to an array
    For Each r In Range("A1:C3")
        If r.Value = h1 Then
            strList(counter) = r.Address
            counter = counter + 1
        ElseIf r.Value = h2 Then
            strList(counter) = r.Address
            counter = counter + 1
        End If
    Next r

'Make Formula

    Formula = "=IFERROR(SUM("

    For Each s In strList
        'only returns array items that have text in them
        If Not s = "" Then
            Formula = Formula & s & ", "
        End If
    Next s

    Formula = Formula + ")"

    Debug.Print Formula


End Sub

Вот таблица, которую я создал для проверки кода:

Результаты: