makro - spalten finden, mit minimalsten Werten

Sub FindeMinSummenSpalten()

    Dim ws As Worksheet

    Dim dataRange As Range

    Dim startColumn As Integer

    Dim minSum As Double

    Dim minSumColumns As Range

    Dim minSumTitle As String

    Dim minSumValue As Double

    

    Set ws = ThisWorkbook.Sheets("1Hz")

    Set dataRange = ws.Range("G8:CR" & ws.Cells(ws.Rows.Count, "G").End(xlUp).Row)

    

    ' Variablen initialisieren

    minSum = WorksheetFunction.Sum(dataRange.Rows(1))

    Set minSumColumns = dataRange.Columns(1).Resize(, 10)

    

    ' Durch jeden Satz von 10 Spalten iterieren

    For startColumn = 1 To dataRange.Columns.Count - 9

        Dim currentSum As Double

        Set currentColumns = dataRange.Columns(startColumn).Resize(, 10)

        currentSum = WorksheetFunction.Sum(currentColumns.Rows(1))

        

        ' Überprüfen, ob die aktuelle Summe kleiner als die minimale Summe ist

        If currentSum  minSum Then

            minSum = currentSum

            Set minSumColumns = currentColumns

        End If

    Next startColumn

    



    minSumTitle = ws.Cells(7, minSumColumns.Column).Value & " bis " & ws.Cells(7, minSumColumns.Column + 9).Value

    

    minSumValue = WorksheetFunction.Sum(minSumColumns.Rows(1))

    

    ws.Range("AM1").Value = minSumTitle

    ws.Range("AQ1").Value = minSumValue

End Sub