Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.05.2024 20:08:41
20.05.2024 18:23:06
20.05.2024 17:14:25
Anzeige
Archiv - Navigation
1716to1720
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Unikatliste mit Kriterium

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
Anzeige
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"
Anzeige
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
Anzeige
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
Anzeige
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
Anzeige
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)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige