Если диапазон переменных> 3, чем действие, иначе сделайте другое действие

Question

Некоторые предыстории: каждый месяц я строю сводную таблицу, в которой примерно 30 бизнес-единиц (по оси Y) - давайте называть их группами.Каждая группа имеет несколько учетных записей GL, которые меняются от месяца к месяцу.Например, в группе 14 может быть 10 учетных записей GL в месяц, а в следующей только 3. Для каждой группы нам необходимо суммирование итогов для учетных записей GL (которые начинаются с PL203000 и PL211010) для каждой группы.Прежде чем мы должны были составить эти счета GL для каждой группы вручную.Это было решено с помощью кода, который я показал ниже.

Код отлично работает, когда в каждой группе более одного аккаунта GL (см. Рис. 1)

Проблема, с которой я сталкиваюсь, заключается в том, что когда есть только одна учетная запись GL, код не суммирует правильные суммы (см. 2-е изображение)

При копании в моем коде вы можете видеть, что он суммирует неправильные разделы, так как у меня есть Rows.Count.End (xlUp), устанавливающийдиапазон.Если есть только одна учетная запись GL, она переходит к следующему разделу, устанавливая неправильную формулу

Возможно, мой код должен быть полностью переработан, чтобы учесть группы, в которых есть только одна учетная запись GL для суммирования?Если да, то какой оператор if можно кодировать, если он игнорирует группы, в которых есть только одна учетная запись GL?

Если нет, то чем VBA может подсчитать диапазон, а если оно меньше 3, игнорироватьгруппа и перейти к следующему?

'this section spits out the values needed to sum
For i = nRowMax To 4 Step -1
If Left(Cells(i, 1), 8) = "PL211010" Or Left(Cells(i, 1), 8) = "PL203000" 
Then
        Cells(i, 4).Copy
        Cells(i, 5).PasteSpecial xlPasteValues

        Range(Cells(i, 1), Cells(i, 4)).Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
End If
Next i
Application.CutCopyMode = False


'this section uses the values the first section specified to write the sum formula
'i believe the macro uses this section of code to write the first formula and the next section of code writes the formulas for the rest of the groups
Dim firstRow As Variant
Dim finalRow As Variant
    finalRow = Range("E" & Rows.Count).End(xlUp).Row
    firstRow = Cells(finalRow, 5).End(xlUp).Row
    If IsNumeric(Cells(finalRow + 1, 5)) Then
        Cells(firstRow, 6).Formula = "=SUM(D" & firstRow & ":D" & finalRow  & ")"
End If

'this section goes through the whole sheet to sum each group
For y = firstRow To 5 Step -1
finalRow = Cells(y, 5).End(xlUp).Row
firstRow = Cells(finalRow, 5).End(xlUp).Row
If firstRow < 5 Then firstRow = 5
If IsNumeric(Cells(finalRow + 1, 5)) Then
    Cells(firstRow, 6).Formula = "=SUM(D" & firstRow & ":D" & finalRow &")"
End If
y = firstRow
'If firstRow = 5 Then Exit Sub
Next y

Answer 1

Если ваш набор данных является достаточно точным примером, вы можете сканировать свои подразделения и выбирать только то, что вам нужно.У меня есть пример кода, который увеличит ваш диапазон сумм, используя функцию Union и применив ее к формуле SUM, когда будет отсканировано все подразделение.Конечно, это только пример, который соответствует показанным данным.Вам придется расширить его, чтобы он соответствовал ситуациям, которые мне не видны.

Чтобы упростить логику, я разделил код на функцию, которая начнет сканирование строк для бизнес-единицы и остановится, когдаон достигает конца бизнес-единицы - тест, который я использую для определения начала следующего BU, - это строка, которая не начинается с «PL».Это может или не может быть правильным для всех ваших данных.

Поскольку этот код проверяет каждую строку и накапливает диапазон суммы, используя Union, если у вас есть только одна ячейка, вы все равно будетеполучить формулу, которая говорит =SUM($D$30), но она работает.

Option Explicit

Sub test()
    Dim dataArea As Range
    Set dataArea = ActiveSheet.Range("A1")

    Do While Not IsEmpty(dataArea.Cells(1, 1))
        Set dataArea = AddSums(dataArea)
    Loop
End Sub

Private Function AddSums(ByRef businessUnitStart As Range) As Range
    '--- loops through cells following the 'Start' range given,
    '    and accumulates the range of accounts to summarize
    '    RETURNS the start of the next business unit range
    Dim accountRow As Range
    Dim account As String
    Set accountRow = businessUnitStart.Offset(1, 0)

    Dim sumArea As Range
    Do While Left$(accountRow.Cells(1, 1).Value2, 2) = "PL"
        account = accountRow.Cells(1, 1).Value2
        If (Left$(account, 8) = "PL211010") Or (Left$(account, 8) = "PL203000") Then
            '--- add this account to the sum formula
            If sumArea Is Nothing Then
                Set sumArea = accountRow.Cells(1, 4)
            Else
                Set sumArea = Union(sumArea, accountRow.Cells(1, 4))
            End If
        End If
        Set accountRow = accountRow.Offset(1, 0)
    Loop

    If Not sumArea Is Nothing Then
        Dim accountSum As Range
        Set accountSum = businessUnitStart.Offset(1, 6)
        accountSum.Formula = "=SUM(" & sumArea.Address & ")"
    End If
    Set AddSums = accountRow
End Function