AW: und warum nicht mit PowerQuery? ...
16.03.2021 23:30:51
Yal
Hallo Claudia,
vielleicht tue ich damit deine VBA-Fähigkeit überstrapzieren, aber probieren wir mal.
Lösungsweg:
_ deine Haupttabelle wird zu eine Datentabelle (Menü "Daten", "Tabelle") gemacht,
_ darauf eine einfache Query. Nur die Preise werden sortiert. Keine Rückgabe,
_ dann pro Artikel, mit Dictionary, sodass es keine Doppelung gibt, die Query gefiltert nach Artikel in eine neues Blatt gerufen,
_ der Link zu Query getrennt.
Noch gibt es bei mir einige Störungen, weil der Code bleibt ab und zu stehen, aber ich glaube es liegt an meinem Excel.
Sub Artikel_auflisten()
Dim Artikel
Dim wQ As Worksheet
Dim D As New Dictionary
Set wQ = Worksheets("Eigenlistungskontrolle")
'DatenTabelle ("Intelligente" Tabelle) erzeugen
If Not ListObject_exists(wQ, "Tabelle1") Then _
wQ.ListObjects.Add(xlSrcRange, wQ.UsedRange, , xlYes).Name = "Tabelle1"
'darauf Query herstellen
If Not Query_exists("Artikel") Then QueryArtikel_herstellen
'Für jedes Artikel, aber nur einmal
For Each Artikel In wQ.ListObjects("Tabelle1").ListColumns("Artikel").DataBodyRange.Cells
If Not D.Exists(Artikel.Value) Then
D(Artikel.Value) = 0
QueryArtikel_anwenden Artikel
End If
Next
End Sub
Private Function ListObject_exists(ws As Worksheet, ListObjectName) As Boolean
On Error Resume Next
ListObject_exists = Not (ws.ListObjects(ListObjectName) Is Nothing)
End Function
Private Function Query_exists(QueryName) As Boolean
On Error Resume Next
Query_exists = Not (ActiveWorkbook.Queries(QueryName) Is Nothing)
End Function
Private Sub QueryArtikel_herstellen()
ActiveWorkbook.Queries.Add Name:="Artikel", Formula:= _
"let" & Chr(13) & Chr(10) _
& " Quelle = Excel.CurrentWorkbook(){[Name=""Tabelle1""]}[Content]," & Chr(13) & Chr(10) _
_
& " SortZ = Table.Sort(Quelle,{{""Preis"", Order.Ascending}})" & Chr(13) & Chr(10) _
& "in" & Chr(13) & Chr(10) _
& " SortZ"
End Sub
Private Sub QueryArtikel_anwenden(ByVal ArtikelNr As String)
Dim Q As QueryTable
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = ArtikelNr
Set Q = ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Artikel; _
Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
With Q
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Artikel] WHERE [Artikel] = " & ArtikelNr)
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = False
.ListObject.DisplayName = "Artikel"
.Refresh BackgroundQuery:=False
End With
ActiveSheet.ListObjects("Artikel").Unlist
End Sub
VG
Yal