Skapa unik lista med villkor

I detta tips ska vi titta närmare på hur vi kan skapa listor med unika värden där vi också ställer villkor för att ett värde ska placeras i listan.

Se också Skapa filtrerade listor


Tipset har sin utgångspunkt i följande uppställning, där villkoret består av ett datumintervall. Givet att villkoret uppfylls och att namnet ej tidigare finns i listan (i G-kolumnen) läggs det till mha nedanstående kod:

 

 

Exempel 1:
 Bygger på en äldre teknik men som fungerar alldeles utmärkt i alla versioner av XL. För att proceduren ska utföras krävs att inmatning sker inom det begränsade cellområdet (se nedan).

Följande kod placeras i modulen ThisWorkbook / DennaArbetsbok:

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
   ThisWorkbook.Worksheets("Exempel 1").OnEntry = ""
End Sub

Private Sub Workbook_Open()
   ThisWorkbook.Worksheets("Exempel 1").OnEntry = "Skapa_Unik_Lista1"
End Sub

 

Följande kod placeras i en allmän modul:

Option Explicit

Sub Skapa_Unik_Lista1()

   Dim rnNamn As Range, rnLista As Range, rnBetyg As Range
   Dim rnStart As Range, rnSlut As Range, rnVarde As Range
   Dim lnRader As Long

   Set rnStart = Range("E1")
   Set rnSlut = Range("E2")
   Set rnBetyg = Range(Range("C2"), Range("C65536").End(xlUp))
   Set rnLista = Range(Range("G1"), Range("G65536").End(xlUp))  

   'Om inte aktiv cell befinner sig inom cellområdet rnBetyg
    'avslutas proceduren.
   If Intersect(rnBetyg, ActiveCell) Is Nothing Then Exit Sub

    Application.ScreenUpdating = False

   Set rnNamn = ActiveCell.Offset(0, -1)

   'Vid ifyllandet av det första betyget sker datumkontroll och
   'namnet läggs till listan om postens datum är inom intervallet.
   If rnNamn.Address = "$B$2" Then
      If rnNamn.Offset(0, -1).Value >= rnStart.Value And _
            rnNamn.Offset(0, -1).Value <= rnSlut.Value Then
                         rnLista(2, 1).Value = Range("B2").Value
                         Exit Sub
      End If
   End If

   'Identifiera nästa tomma rad i den unika listans kolumn.
   lnRader = Application.WorksheetFunction.CountA(ActiveSheet.Range("G:G")) + 1

   'Här sker kontroll om posten uppfyller datumintervallet eller inte.
   If rnNamn.Offset(0, -1).Value >= rnStart.Value And _
         rnNamn.Offset(0, -1).Value <= rnSlut.Value Then

      'Här kontrolleras om namnet redan existerar i listan eller inte.
      With rnLista
         Set rnVarde = .Find(What:=rnNamn.Value)
         If rnVarde Is Nothing Then
            'Om namnet ej finns läggs det till i listan
            rnLista(lnRader, 1).Value = rnNamn.Value
         End If
      End With
   End If

    Application.ScreenUpdating = True

 End Sub

 

Exempel 2:

Här används händelsen Worksheet_Change för det aktuella arbetsbladet (Exempel 2)

Följande ändring görs i arbetsbladets modulkod jämfört med ovanstående kod:

Private Sub Worksheet_Change(ByVal Target As Range)

 'RnBetyg ersätts med Target enligt följande:

Set Target = Range(Range("C2"), Range("C65536").End(xlUp))

If Intersect(Target, ActiveCell) Is Nothing Then Exit Sub

End Sub

 

För att erhålla antal förekomster av respektive unikt namn inom datumintervallet  används följande formel: