Autofiltrering med VBA

Autofiltrering med VBA

Här demonstreras en teknik för att filtrera en lista mha en combobox, vilken håller en unik lista av värden. Denna tekniska lösning blir intressant när vi använder oss av flera comboboxar och vill skapa ett användarvänligt gränssnitt.

Koden kan kopieras och klistras in direkt i berörda moduler eller så kan du hämta ett exempel här.

Följande bild visas förutsättningarna för exemplet:

Det vi ska göra är följande:

Skapa en unik lista av leverantörer, vilken tilldelas comboboxen.

Skapa en autofiltrering för comboxen, där val av leverantör styr vilka poster som ska visas i listan.

Dölja knapparna i autofiltreringfälten i listan.

Skapa möjlighet att visa alla poster efter filtrering.

När ovanstående är klart kan vi dölja hela B-kolumnen.

Steg 1 - Skapa Autofilter-listan

Följande procedur skapas i en standardmodul:

Option Explicit

Sub Skapa_Autofilter_Lista()

   '© 2002 Alla rättigheter XL-Dennis

   Dim wbBok As Workbook

   Dim wsBlad As Worksheet

   Dim rnLeverantor As Range, rnFilter As Range

   Dim vaLeverantor As Variant, vaLev As Variant

   Dim ncLeverantor As New Collection

   Dim i As Long

   Set wbBok = ThisWorkbook

   Set wsBlad = wbBok.Worksheets("Blad1")

    Application.ScreenUpdating = False

    With wsBlad

      'Om statusen för Autofilter är påslagen stängs den av här för

      'att ta bort det dolda namnet "FilterDatabas", vilket refererar till

      'det senaste skapade filtercellområdet.

      .AutoFilterMode = False

      'Här aktiveras Autofilter-funktionen.

      .Range("B4").AutoFilter

      .OLEObjects("ComboBox1").Object.Clear

      Set rnLeverantor = .Range(.Range("B4"), .Range("B65536").End(xlUp))

   End With

   'Döljer Autofilter-fälten för listan.

   Set rnFilter = wsBlad.AutoFilter.Range

   For i = 1 To 3

      rnFilter.AutoFilter Field:=i, Visibledropdown:=False

   Next i

   'Läser in levarantörsnamn från det definierade cellområdet.

   vaLeverantor = rnLeverantor.Value

   'Skapar en unik lista av leverantörer (Dock ej sorterad lista).

   On Error Resume Next

   For i = LBound(vaLeverantor) To UBound(vaLeverantor)

      ncLeverantor.Add vaLeverantor(i, 1), CStr(vaLeverantor(i, 1))

   Next i

   On Error GoTo 0

   'Tilldelar listväljaren den unika listan.

   With wsBlad

      For Each vaLev In ncLeverantor

         .OLEObjects("ComboBox1").Object.AddItem vaLev

      Next vaLev

   End With

    Application.ScreenUpdating = True

End Sub

Steg 2 - Visa alla poster

Följande procedur skapas i en standardmodul:

Sub Visa_Alla_Poster()

   '© 2002 Alla rättigheter XL-Dennis

   Dim wbBok As Workbook

   Dim wsBlad As Worksheet

   Set wbBok = ThisWorkbook

   Set wsBlad = wbBok.Worksheets("Blad1")

   Application.ScreenUpdating = False

   'Om filtrering har gjorts visas alla poster igen.

   With wsBlad

      If .FilterMode Then .ShowAllData

   End With

   Application.ScreenUpdating = True

End Sub

Steg 3 - Visa filtrerad lista

Följande händelseprocedur skapas i arbetsbladets modul:

Option Explicit

Private Sub ComboBox1_Change()

   '© 2002 Alla rättigheter XL-Dennis

   Dim rnAktiv As Range

   Application.ScreenUpdating = False

   Set rnAktiv = ActiveCell

   Range("B4").Select

   'Här sker filtreringen

   Selection.AutoFilter Field:=1, Criteria1:=ComboBox1.Value

   rnAktiv.Select

   Application.ScreenUpdating = True

End Sub

Så här kan listan se ut efter att filtrering har gjorts och B-kolumnen har dolts: