Makro, SUBTOTAL + beregningsfunktion

Har du mulighed for at sende en kopi af filen: pb@supertekst-it.dk

Hermed gjort :D

Dim antalRæk
Const sats1 = 100          'kan ændres efter behov
Const sats2 = 50            '-"-
Public Sub beregning()
    Application.ScreenUpdating = False
   
Rem find antal rækker
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
   
Rem gennemløb at rækker - find om TOTAL i kolonne A
    For ræk = 1 To antalRæk
        indhold = Cells(ræk, 1)
Rem findes ordet "total" i cellen
        If InStr(LCase(indhold), "total") > 0 Then
Rem indsæt formel i kolonne G (7) & I (9)
            Cells(ræk, 7).Formula = "=F" & CStr(ræk) & "*" & CStr(sats1)
            Cells(ræk, 9).Formula = "=H" & CStr(ræk) & "*" & CStr(sats2)
        End If
    Next ræk

Rem Tilpas kolonne-bredde
    Columns.AutoFit
   
    Application.ScreenUpdating = True
   
    MsgBox ("Beregning afsluttet")
End Sub
Private Sub CommandButton1_Click()
    beregning
End Sub