Lagersammanställning

Sammanställa lagerdata

I detta tips visas hur vi på ett smidigt kan sammanställa artiklar och i vilka lager dessa finns i

Utgångspunkten i exemplet är att vi har en serie artikelnummer som förekomster i fyra olika lager. Dessa ska sammanställas och där förekomsten i respektive lager ska redovisas på artikelnummernivå.

Följande bild visas den ursprungliga listan:

När nedanstående procedur har exekverats har, förutom ett nytt arbetsblad, följande sammanställning skapats:

Följande procedur genererar sammanställningen:

Sub Sammanstallning()

   '© 2002 Alla rättigheter XL-Dennis

   Dim wbLager As Workbook

   Dim wsLager As Worksheet

   Dim rnArtiklar As Range, rnVarde As Range

   Dim Artiklar As New Collection

   Dim VaArtiklar As Variant

   Dim stAdress As String

   Dim i As Long, j As Long, lnAntal As Long, x As Long, y As Long

   With Application

      .ScreenUpdating = False

      .DisplayAlerts = False

   End With

   Set wbLager = ThisWorkbook

   Set wsLager = wbLager.Worksheets("Blad1")

   With wsLager

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

      Set rnArtiklar = .Range("A2:A" & lnAntal)

   End With

   VaArtiklar = rnArtiklar.Value

   'Skapar en unik artikelnummerserie.

   For i = 1 To UBound(VaArtiklar, 1)

      On Error Resume Next

      Artiklar.Add VaArtiklar(i, 1), CStr(VaArtiklar(i, 1))

      On Error GoTo 0

   Next i

   On Error Resume Next

   ThisWorkbook.Worksheets("Sammanställning").Delete

   On Error GoTo 0

   'Lägger till ett nytt arbetsblad.

   ThisWorkbook.Worksheets.Add after:=Worksheets(Worksheets.Count)

   ActiveSheet.Name = "Sammanställning"

   'Skriver den unika artikelnummerserien till det nya arbetsbladet.

   For x = 1 To Artiklar.Count

      Cells(1 + x, 1).Value = Artiklar(x)

   Next x

   'Skriver ut lagerrubrikerna i det nya arbetsbladet.

   With Range("A1:E1")

      .Value = Array("Artiklar", "Lager 1", "Lager 2", "Lager 3", "Lager 4")

      .Font.Bold = True

   End With

   'Här sker sammanställning per artikelnummer och per lager

   With rnArtiklar

      For j = 1 To Artiklar.Count

         Set rnVarde = .Find(What:=Artiklar(j))

         If Not rnVarde Is Nothing Then

            stAdress = rnVarde.Address

            Do

               If Not IsEmpty(rnVarde.Offset(0, 1)) Then

                  If IsEmpty(Cells(1 + j, 2)) Then

                     Cells(1 + j, 2).Value = "1"

                  End If

               End If

               If Not IsEmpty(rnVarde.Offset(0, 2)) Then

                  If IsEmpty(Cells(1 + j, 3)) Then

                     Cells(1 + j, 3).Value = "2"

                  End If

               End If

               If Not IsEmpty(rnVarde.Offset(0, 3)) Then

                  If IsEmpty(Cells(1 + j, 4)) Then

                     Cells(1 + j, 4).Value = "3"

                  End If

               End If

               If Not IsEmpty(rnVarde.Offset(0, 4)) Then

                  If IsEmpty(Cells(1 + j, 5)) Then

                     Cells(1 + j, 5).Value = "4"

                  End If

               End If

               Set rnVarde = .FindNext(rnVarde)

            Loop While Not rnVarde Is Nothing And rnVarde.Address <> stAdress

         End If

      Next j

   End With

   With Application

      .ScreenUpdating = True

      .DisplayAlerts = True

   End With

End Sub