Sum fra højre mod venstre og markér celle der er tættest på 0

Hvor mange måneder er der tale om?

Det er variabelt hen over året, p.t. er det kolonne G - P

OK - her er i første omgang et forsøg baseret på opstillingen iflg. dit oplæg:

Dim mdSum(), antalKol, antalRæk
Private Sub opTælling()
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
    antalKol = ActiveCell.SpecialCells(xlLastCell).Column
   
    ReDim mdSum(antalKol)
   
    For ræk = 2 To antalRæk
        akksum = 0
        nulstilMdSum
       
        For md = antalKol To 1 Step -1
            akksum = akksum + Cells(ræk, md)
            mdSum(md - 1) = akksum
        Next md
        mdindex = findMålVærdi
        Cells(ræk, mdindex).Interior.ColorIndex = 4
   
    Next ræk
   
    MsgBox ("Gennemløb afsluttet")
End Sub
Private Function findMålVærdi()
Dim laveste
    laveste = 999999
    For ix = antalKol - 1 To 1 Step -1
        værdi = Abs(mdSum(ix))
        If værdi < laveste Then
            findMålVærdi = ix + 1
            laveste = værdi
        End If
    Next ix
End Function
Private Sub nulstilMdSum()
    For f = 0 To antalKol
        mdSum(f) = 0
    Next
End Sub

Den fejler i den første den : akksum = akksum + Cells(ræk, md)

Betyder det noget, at regnearket benytter månederne i modsat rækkefølge ?

Hjælper det hvis jeg sender et eksempel til dig ?

Ja tak - du er velkommen (pb@supertekst-it.dk), hvis du har glemt adressen :-)

Rem Version 3
Rem =========
Const startKol = 7              'G
Dim mdSum(), antalKol, antalRæk
Sub opTælling()
    Application.ScreenUpdating = False
   
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
    antalKol = tælAntalMåneder
   
    ReDim mdSum(antalKol)
   
    For ræk = 2 To antalRæk
Rem Kun hvis Kol A er udfyldt
        If Cells(ræk, 1) <> "" Then
            akksum = 0
            nulstilMdSum
       
            For md = antalKol + startKol - 1 To startKol Step -1
                If Cells(ræk, md) <> "" Then
                    akksum = akksum + Cells(ræk, md)
                    mdSum(md - startKol + 1) = akksum
                End If
            Next md
            mdindex = findMålVærdi
           
            If mdindex > 0 Then
Rem Opret kommentar med sum
                Cells(ræk, mdindex + startKol - 1).AddComment CStr(mdSum(mdindex))
   
Rem FARVE-MARKERING UDGÅR
'                Cells(ræk, mdindex + startKol - 1).Interior.ColorIndex = 4
            End If
        End If
    Next ræk
   
    Application.ScreenUpdating = True
   
    MsgBox ("Gennemløb afsluttet")
End Sub
Private Function findMålVærdi()
Dim laveste
    laveste = 999999
    For ix = antalKol To 1 Step -1
        If mdSum(ix) <> "" Then
            værdi = mdSum(ix)
Rem Kun positiv værdier
            If værdi < laveste And værdi >= 0 Then
                findMålVærdi = ix
                laveste = værdi
            End If
        End If
    Next ix
End Function
Private Sub nulstilMdSum()
    For f = 0 To antalKol
        mdSum(f) = ""
    Next
End Sub
Private Function tælAntalMåneder()
    tælAntalMåneder = 0
    For kol = 7 To 244
        If Cells(1, kol) <> "" Then
            tælAntalMåneder = tælAntalMåneder + 1
        Else
            Exit Function
        End If
    Next kol
End Function

Forklaring til løsningen, som indeholder lidt ekstra "super"-features.

Ovenstående modulkode identificerer og markerer den celle hvori summen fra højre mod venstre er tættest på 0 ( positive værdi ) ... summen indsættes som kommentar i den aktuelle celle.

En helt igennem smart løsning