AW: VBA - Werte suchen, kopieren & einfü
08.12.2022 17:41:18
Yal
Hallo Thomas,
mit Power Query (PQ) wärst Du vielleicht besser bedient. Insbesondere, wenn deine Quelldaten aus einer Datei kommen.
Ein guter Überblick über PQ bekommt man hier: https://excelhero.de/power-query/power-query-ganz-einfach-erklaert
Folgende Makro geht über PQ: die Eingangsliste wird zu einer "intelligente Tabelle" (Siehe "Einfügen, "Tabelle"), diese wird in einer PQ-Abfrage als Quelle verwendet. Darin werden alle Spalte ausser die erste depivotiert, gefiltert auf Datum "nach" Heute minus 8 Wochen, dann wieder pivotiert und ausgegeben, Anschliessend wird der Link zu Query aufgelöst.
Wenn Du eine "Auswertung" auf diese Daten, wäre vieilleicht sinnvoll, die Daten nicht normal zu pivotieren, bevor sie ausgegeben werden.
Sub Daten_ausfiltern()
Dim Elt
Dim ws As Worksheet
'Löschung aller Queries
For Each Elt In ActiveWorkbook.Queries
Elt.Delete
Next
'Herstellung der "intelligente Tabelle"
Set ws = Worksheets("Eingabe")
If ws.ListObjects.Count > 0 Then
Set Elt = ws.ListObjects(1)
Else
Set Elt = ws.ListObjects.Add(xlSrcRange, Range("$A$2").CurrentRegion, , xlYes)
End If
'Herstellung der Power Query Abfrage
ActiveWorkbook.Queries.Add Name:=Elt.Name, Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Quelle = Excel.CurrentWorkbook(){[Name=""" & Elt.Name & """]}[Content]," & Chr(13) & "" & Chr(10) _
& " #""Entpivotierte andere Spalten""= Table.UnpivotOtherColumns(Quelle, {""Spalte1""}, ""Attribut"", ""Wert"")," & Chr(13) & "" & Chr(10) _
& " #""Geänderter Typ1"" = Table.TransformColumnTypes(#""Entpivotierte andere Spalten"",{{""Attribut"", type date}})," & Chr(13) & "" & Chr(10) _
& " #""Gefilterte Zeilen"" = Table.SelectRows(#""Geänderter Typ1"", each [Attribut] >= Date.From(Date.AddWeeks(DateTime.LocalNow(), -8)))," & Chr(13) & "" & Chr(10) _
& " #""Pivotierte Spalte"" = Table.Pivot(Table.TransformColumnTypes(#""Gefilterte Zeilen"", {{""Attribut"", type text}}, ""de-DE""), List.Distinct(Table.TransformColumnTypes(#""Gefilterte Zeilen"", {{""Attribut"", type text}}, ""de-DE"")[Attribut]), ""Attribut"", ""Wert"", List.Sum)" & Chr(13) & "" & Chr(10) _
& "in" & Chr(13) & "" & Chr(10) & " #""Pivotierte Spalte"""
'Neues Blatt
Sheets.Add After:=ActiveSheet
Set ws = ActiveSheet
'Abfrage in das Blatt herausgeben
With ws.ListObjects.Add(SourceType:=0, _
Source:="OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & Elt.Name & ";Extended Properties=""""", Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [" & Elt.Name & "]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = False
'Aktualisieren
.Refresh BackgroundQuery:=False
End With
'Verlinkung zu Query lösen
ws.ListObjects(1).Unlink
End Sub
VG
Yal