Summa VBA

Del- och totalsummor i VBA

I detta tips demonstreras tekniker för att utföra beräkningar, både för del- och totalsummor, och där vi dels infogar summa-funktionen och dels utför en summering innan summan anges i cell.

Här antas att vi har en tomrad mellan värdeserierna i B-kolumnen och att en totalsummering sker nedanför uppställningen.

Option Explicit

Sub Skapa_Del_Total_Summeringar()

   '© 2003 Alla rättigheter XL-Dennis

   Dim wbBok As Workbook

   Dim wsBlad As Worksheet

   Dim rnData As Range, rnSumma As Range, rnCell As Range, rnTSumma As Range

   Dim lnTSumma As Long, i As Long

   On Error GoTo Errorhandling

   Set wbBok = ThisWorkbook

   Set wsBlad = wbBok.Worksheets("Blad1")

   With wsBlad

      Set rnData = .Range(.Range("B2"), .Range("B65536").End(xlUp))

      'För att få med den sista delsummeringen utökas cellområdet med 1 rad.

      Set rnData = rnData.Resize(rnData.Rows.Count + 1, 1)

   End With

   Application.ScreenUpdating = False

   For i = rnData.Rows.Count To 1 Step -1

      If IsEmpty(rnData(i, 1).Value) Then

         With rnData(i, 1)

            'Här identifieras cellområdet som ska summeras.

            Set rnSumma = Range(.Offset(-1), .Offset(-1).End(xlUp))

            'Här skrivs SUMMA-formeln in med absoluta cellreferenser.

            .Formula = "=SUM(" & rnSumma.Address & ")"

            .Font.Bold = True

         End With

      End If

   Next

   'Här beräknas totalsumman av delsummeringarna.

   lnTSumma = Application.WorksheetFunction.Sum(Range("B2:" & Range("B65536").End(xlUp).Address). _
                      SpecialCells(xlFormulas, xlNumbers))

   With wsBlad

      Set rnTSumma = .Range("B65536").End(xlUp).Offset(2, 0)

   End With

   'Här infogas den beräknade totalsumman.

   rnTSumma.Value = lnTSumma

   Application.ScreenUpdating = True

   Exit Sub

Errorhandling:

   MsgBox "Ett oväntat fel har inträffat: " _

         & Err.Description & " " & Err.Number, vbExclamation

End Sub