Перебирая группу и добавляя формулу суммы - PullRequest
0 голосов
/ 28 августа 2018

У меня есть структура с несколькими группами и подгруппами, где уровень подгруппы может превышать 10. Аналогично этому (это уровень 4).

enter image description here

Теперь я хочу подвести итог или выполнить некоторые вычисления в каждой группе, и в конце я хочу получить сумму в группе 1.

Я хочу сумму, аналогичную показанной на изображении. Каждая группа будет добавлена, после чего будет рассчитано окончательное значение. Количество строк или групп для меня является переменным, поэтому мне нужно добавить формулу через VBA, после того, как у меня есть ввод (строки и группы).

Заранее спасибо.

1 Ответ

0 голосов
/ 04 сентября 2018

Это то, что я хотел ...

    'Update assembly levels
            For i = 10 To 1 Step -1
                Call UpdateAssemblyLevel(RowCount, i)
            Next i

    Sub UpdateAssemblyLevel(RCount As Integer, CurrentLevel As Integer)

    'Adding Formulae for assembly levels

    Dim MassRange As Range
    Dim AssemblyMass As Integer
    Dim MR As Range           
    Set MassRange = Nothing        
    AssemblyMass = 0

        On Error Resume Next
        For i = RCount To 2 Step -1

            If Cells(i, 1).Value = CurrentLevel Then        
                Set MR = Cells(i, 12)
                MsgBox (MR.Value)
                    If Not MassRange Is Nothing Then
                        Set MassRange = Union(MassRange, MR)
                    Else
                        Set MassRange = MR
                    End If

            ElseIf Cells(i, 1).Value = CurrentLevel - 1 Then
                    'Add the Sum here
                    If MassRange Is Nothing Then
                        'Do Nothing
                    Else       
                        Cells(i, 12).Formula = "=SUM(" & MassRange.Address & ")" 'This gives me wrong value then desired output                            
                        Set MassRange = Nothing
                    End If

                AssemblyMass = 0

            Else
                'Do nothing
            End If        

        Next i

    End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...