Unikatliste mit Kriterium

Forumthread: Unikatliste mit Kriterium

23.10.2019 14:19:08

Fred

Hallo Excel & VBA Profis,
ich bekomme mal wieder etwas nicht hin.
In Blatt "Main" möchte ich beginnend "A9" eine Unikatliste aus den Einträgen in
Sheet "Basis"
Spalten "F:G"
Kriterium: nur die entsprechenden Einträge, in denen in Spalte "BP" ein Wert mehr als 0 steht.
Kann mir bitte da jemand weiterhelfen?
Zum besseren Verständnis eine Beispielmappe (mit Wunschergebnis)
https://www.herber.de/bbs/user/132689.xlsb
Gruss
Fred

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

PQ Lösung

23.10.2019 14:44:08

ChrisL
AW: PQ Lösung

23.10.2019 15:02:24

Fred
AW: PQ Lösung

23.10.2019 15:10:31

Nepumuk
AW: PQ Lösung

23.10.2019 15:28:32

Fred
AW: PQ Lösung

23.10.2019 15:31:37

Nepumuk
AW: PQ Lösung

23.10.2019 15:36:30

Nepumuk
AW: PQ Lösung

23.10.2019 15:55:49

Fred
AW: PQ Lösung

23.10.2019 15:19:52

ChrisL
AW: PQ Lösung

23.10.2019 15:22:37

EtoPHG
AW: PQ Lösung

23.10.2019 15:40:49

Fred

PQ Lösung

23.10.2019 14:44:08

ChrisL

Hi Fred
Hier eine Lösung mit Power Query
https://www.herber.de/bbs/user/132691.xlsx
- Filter setzten
- Überflüssige Spalten löschen
- Entpivotieren
- Gruppieren
- Sortieren
cu
Chris
let
Quelle = Excel.CurrentWorkbook(){[Name="Tabelle1"]}[Content],
#"Gefilterte Zeilen" = Table.SelectRows(#"Geänderter Typ", each [Kriterium] > 0),
#"Entfernte Spalten" = Table.RemoveColumns(#"Gefilterte Zeilen",{"ID", "Liga", "Datum", "Jahr", "Saison", "Heim", "Gast", "(1Hz) H", "(1Hz) A", "(2Hz) H", "(2Hz) A", "H_Times", "G_Times", "Times_Ordnung", "1st Tor Heim", "1st Tor Gast", "1st Tor", "HT-Tore 0-15", "HT-Tore 16-30", "HT-Tore 31-45", "HT-Tore 46-60", "HT-Tore 61-75", "HT-Tore 76-90+", "GT-Tore 0-15", "GT-Tore 16-30", "GT-Tore 31-45", "GT-Tore 46-60", "GT-Tore 61-75", "HT-Tore 76-90+2", "min", "min3", "min4", "min5", "min6", "min7", "min8", "min9", "min10", "min11", "min12", "min13", "min14", "min15", "min16", "min17", "min18", "min19", "min20", "min21", "H S", "H U", "H N", "A S", "A U", "A N", "over 2,5", "both", "inMin 0-30", "inMin 31-60", "inMin 61-90+", "cleanSheet", "1Hz over 0,5", "1Hz over 1,5", "2Hz over 0,5", "2Hz over 1,5", "Kriterium"}),
#"Entpivotierte Spalten" = Table.UnpivotOtherColumns(#"Entfernte Spalten", {}, "Attribut", "Wert"),
#"Entfernte Spalten1" = Table.RemoveColumns(#"Entpivotierte Spalten",{"Attribut"}),
#"Gruppierte Zeilen" = Table.Group(#"Entfernte Spalten1", {"Wert"}, {{"Anzahl", each Table.RowCount(_), type number}}),
#"Sortierte Zeilen" = Table.Sort(#"Gruppierte Zeilen",{{"Wert", Order.Ascending}})
in
#"Sortierte Zeilen"

AW: PQ Lösung

23.10.2019 15:02:24

Fred

Hi Chris,
das Ergebnis ist mega,- sogar mit entsprechender Anzahl - mega-sensationell!
Mit PQ hatte ich bisher wohl noch nie was gemacht.
Eventuell möchte ich weitere solcher "Abfragen" ins gleiche Sheet oder in ein anderes usw.
Wie ist das mit den Code zu verstehen, den du unten angefügt hast. Wo ist dieser im Sheet zu finden?
Danke für deine Arbeit!
Gruß
Fred

AW: PQ Lösung

23.10.2019 15:10:31

Nepumuk

Hallo Fred,
oder einfach auf einen Button klicken.

Option Explicit

Public Sub Unikatliste()
    Dim objDataObject As Object, objDictionary As Object
    Dim strTemp As String
    Dim avntTemp As Variant, vntItem As Variant
    With Worksheets("Basis")
        Call .Rows(9).AutoFilter(Field:=68, Criteria1:=">0")
        With .AutoFilter.Range
            Call Range(.Cells(2, 7), .Cells(.Rows.Count, 7)).Copy
        End With
        DoEvents
        Set objDataObject = CreateObject(class:="new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        Call objDataObject.GetFromClipboard
        strTemp = objDataObject.GetText
        Set objDataObject = Nothing
        .AutoFilterMode = False
    End With
    strTemp = Left$(strTemp, Len(strTemp) - 2)
    avntTemp = Split(strTemp, vbCrLf)
    Set objDictionary = CreateObject(class:="Scripting.Dictionary")
    With objDictionary
        For Each vntItem In avntTemp
            .Item(Key:=vntItem) = vbNullString
        Next
    End With
    With Worksheets("Main")
        Call .Range(.Cells(9, 1), .Cells(.Rows.Count, 1)).ClearContents
        .Cells(9, 1).Resize(objDictionary.Count, 1).Value = Application.Transpose(objDictionary.Keys)
    End With
    Set objDictionary = Nothing
End Sub

Gruß
Nepumuk

AW: PQ Lösung

23.10.2019 15:28:32

Fred

Hallo Nepumuk,
"einfach klicken" ist natürlich vertrauter :-)
Dein Ergebnis ist allerdings nicht das, welches ich erhofft habe. Ich glaube, es werden nur die Unikate aus Spalte "G" aufgeführt.
Wo ist da der Fehler?
Gruß
Fred

AW: PQ Lösung

23.10.2019 15:31:37

Nepumuk

Hallo Fred,
willst du beide Mannschaftsspalten untereinander auflisten? Ich hab das nicht so ganz verstanden.
Gruß
Nepumuk

AW: PQ Lösung

23.10.2019 15:36:30

Nepumuk

Hallo Fred,
alles klar, dann so:

Option Explicit

Public Sub Unikatliste()
    Dim objDataObject As Object, objDictionary As Object
    Dim strTemp As String
    Dim avntTemp As Variant, vntItem As Variant
    With Worksheets("Basis")
        Call .Rows(9).AutoFilter(Field:=68, Criteria1:=">0")
        With .AutoFilter.Range
            Call Range(.Cells(2, 6), .Cells(.Rows.Count, 7)).Copy
        End With
        DoEvents
        Set objDataObject = CreateObject(class:="new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        Call objDataObject.GetFromClipboard
        strTemp = objDataObject.GetText
        Set objDataObject = Nothing
        .AutoFilterMode = False
    End With
    strTemp = Left$(strTemp, Len(strTemp) - 2)
    avntTemp = Split(strTemp, vbCrLf)
    Set objDictionary = CreateObject(class:="Scripting.Dictionary")
    With objDictionary
        For Each vntItem In avntTemp
            .Item(Key:=Split(vntItem, vbTab)(0)) = vbNullString
            .Item(Key:=Split(vntItem, vbTab)(1)) = vbNullString
        Next
    End With
    With Worksheets("Main")
        Call .Range(.Cells(9, 1), .Cells(.Rows.Count, 1)).ClearContents
        .Cells(9, 1).Resize(objDictionary.Count, 1).Value = Application.Transpose(objDictionary.Keys)
    End With
    Set objDictionary = Nothing
End Sub

Gruß
Nepumuk

AW: PQ Lösung

23.10.2019 15:55:49

Fred

Hallo Nepumuk,
Super, nun stimmt die Liste! - Die Anzahl der Teamnamen bekomme ich wohl über zählenwenns() hin.
Gruß
Fred

AW: PQ Lösung

23.10.2019 15:19:52

ChrisL

Hi Fred
Der Code ist im erweiterten Editor von PQ zu finden. Es handelt sich lediglich um eine Aufzeichnung/Zusammenfassung der durchgeführten Arbeitsschritte d.h. du musst dich nicht mit dem Code beschäftigen.
Schau dir einfach mal ein 2 minütiges Intro-Video zu PQ an. Ist der Abfrage-Editor erstmal geöffnet, erklärt sich vieles von selbst.
cu
Chris

AW: PQ Lösung

23.10.2019 15:22:37

EtoPHG

Hallo Fred,
1. Tabelle selektieren
2. Tab [Daten]
3. [Button Abfragen und Verbindungen]
4. Doppelklick auf Quelle
5. Im PQ Editor - [Erweiterter Editor]
6. Das ist dein Code
Userbild

Gruess Hansueli

AW: PQ Lösung

23.10.2019 15:40:49

Fred

Hallo EtoPHG,
danke für das "ratz-fatz Tutorial"!
Klappt!
Gruß
Fred

Beliebteste Forumthreads (12 Monate)

Forumthread: Unikatliste mit Kriterium

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread