Sammanställa de senaste värdena

Detta tips belyser hur vi löpande kan sammanställa t ex de senaste 20 värdena mht till vissa villkor.

Utgångspunkten här är att vi har:

 

Villkor:

 

Sub Sammanstalla_Senaste_20()

   '© 2002 Alla rättigheter XL-Dennis

   Dim wbBok As Workbook

   Dim wsBlad As Worksheet

   Dim rnVarde As Range, rnDatum As Range, rnMal As Range

   Dim i As Long, j As Long, lnAntal As Long

 

   Set wbBok = ThisWorkbook

   Set wsBlad = wbBok.Worksheets("Blad1")

 

   With wsBlad

      lnAntal = .Range(.Range("A1"), .Range("A65536").End(xlUp)).Rows.Count

      Set rnDatum = .Range("A1:A" & lnAntal)

      Set rnVarde = .Range("B1:B" & lnAntal)

      Set rnMal = .Range("F2:G21")

   End With

 

   Application.ScreenUpdating = False

    rnMal.ClearContents

    i = 0

    'Räknare går här stegvis nedåt

   For j = lnAntal To 1 Step -1

      If i = 20 Then Exit For

      'Här utvärderas om veckodag är lika med lördag eller söndag eller inte.

      If Application.Weekday(rnDatum(j, 1), 2) < 6 Then

         If Not IsEmpty(rnVarde(j, 1)) Or rnVarde(j, 1).Value <> 0 Then

            i = i + 1

            rnMal(i, 1).Value = rnVarde(j, 1).Offset(0, -1)

            rnMal(i, 2).Value = rnVarde(j, 1)

         End If

      End If

   Next j

 

   'Sortering av den ifyllda tabell
   rnMal.Sort Key1:=Range(
"F2"), Order1:=xlAscending

    Application.ScreenUpdating = True  

End Sub