Сумма варьируется в зависимости от значения с VBA

Question

Я пытаюсь сделать следующее с VBA.Представьте, что у меня есть некоторые данные следующим образом:

Я бы хотел, чтобы мой конечный результат был суммой всех данных, которые находятся между "BEGINDATA" и"ENDDATA".Так бы это выглядело так:

Моя цель - получить зеленые данные и написать их рядом с «ENDDATA»

Любая идея или предложение?

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

Answer 1

Вы также можете добиться этого, используя Find, что будет быстрее, чем зацикливание

Option Explicit
Sub Demo()
    Dim BeginData As Range, EndData As Range
    Dim FirstBeginAddress As String

    ' Update with your range
    With Sheet1.Columns(1)
        Set BeginData = .Find(what:="BEGINDATA", after:=.Cells(.Cells.Count), LookIn:=xlValues, lookat:=xlWhole)

        If Not BeginData Is Nothing Then
            FirstBeginAddress = BeginData.Address
            Set EndData = .Find("ENDDATA", after:=BeginData)
            Do
                Debug.Print "BeginAddress", BeginData.Address
                If Not EndData Is Nothing And EndData.Row > BeginData.Row Then
                    Debug.Print "EndAddress", EndData.Address
                    '' For Formula
                    EndData.Offset(0, 1).Formula = "=SUM(" & Range(BeginData.Offset(1, 1), EndData.Offset(-1, 1)).Address & ")"
                    '' For value
                    'EndData.Offset(0, 1).Value2 = Application.Sum(Range(BeginData.Offset(1, 1), EndData.Offset(-1, 1)))
                    Set EndData = .Find("ENDDATA", after:=EndData)
                Else
                    Err.Raise 998, "Demo", "Unable to find Data Footer"
                End If
                Set BeginData = .Find("BEGINDATA", after:=BeginData)
            Loop Until BeginData Is Nothing Or BeginData.Address = FirstBeginAddress
        Else
            Err.Raise 999, "Demo", "Unable to find Data Header"
        End If
    End With
End Sub

Answer 2

Попробуйте:

Option Explicit

Sub test()

    Dim Lastrow As Long, BeginData As Long, EndData As Long, i As Long

    With ThisWorkbook.Worksheets("Sheet1")

        Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row

        For i = 1 To Lastrow

            If .Range("A" & i).Value = "BEGINDATA" Then
                BeginData = i
            ElseIf .Range("A" & i).Value = "ENDDATA" Then
                EndData = i
            End If

            If EndData > BeginData Then
                .Range("B" & i).Value = Application.Sum(.Range("B" & BeginData + 1 & ":B" & EndData - 1))
            End If

        Next i

    End With

End Sub

Другая версия:

Option Explicit

Sub test()

    Dim Lastrow As Long, BeginData As Long, EndData As Long, i As Long

    With ThisWorkbook.Worksheets("Sheet1")

        Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row

        For i = 1 To Lastrow

            If .Range("A" & i).Value = "BEGINDATA" Then
                BeginData = i
            ElseIf .Range("A" & i).Value = "ENDDATA" Then
                EndData = i
            End If

            If EndData > BeginData Then
                With .Range("B" & i)
                    .Value = Application.Sum(Sheet1.Range("B" & BeginData + 1 & ":B" & EndData - 1))
                    .Interior.Color = vbGreen
                End With
            End If

        Next i

    End With

End Sub