VBA Dictonary oder Array?

Hallo zusammen,
ich hoffe ihr könnt mir helfen, da ich alleine leider nicht mehr weiterkomme.
Zu meiner Frage:
Ich habe eine Tabelle mit meinen Rohdaten die immer gleich ausgewertet aus dem System kommt. Nun muss ich die Daten für meine Verwendung weiter aufbereiten.
In Spalte Q steht das notwendige Datum
In Spalte K ein Kriterium und
In Spalte C ist die Belegnummer, hiervon kann es mehrere pro Datum und Kriterium geben
Mein Wunsch ist jetzt ein Makro, dass:
1. Datum (Q) und Kriterium 1 (K) in eine neue Tabelle einordnet (Spalte A und B) unter der Berücksichtigung, dass
2. Zu jedem Datum und Kriterium 1 es mehrere Belegnummern gibt. Diese sollten in Spalte C eingeordnet werden
3. Zu jeder Belegnummer gibt es wiederum Werte die in den Spalten S,N und T der Ursprungstabelle sind. Diese sollen dann den Belegnummern in der neuen Tabelle zugeordnet werden.
4. Nach jedem Tag und Kriterium 1 soll in der neuen Tabelle die Summe gezogen werden und 1 Zeile frei bleiben.
Ich kenne mich mit For-Schleifen eigentlich sehr gut aus. Habe aber überhaupt keine Idee wie ich es damit umgesetzt bekomme. Mit Arrays und Dictonarys habe ich noch nie gearbeitet.
Kann mir jemand helfen?
Vielen Dank im Vorfeld.
Datei ist hier zu finden: https://www.herber.de/bbs/user/135886.xlsx

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Liste_erstellen() Dim strKEY As String, objDaten As Object, arrItems, oObj Dim arrDaten(), arrTmp Dim rngC As Range Dim n As Integer, i As Integer Const cstrDELIM As String = "|" Set objDaten = CreateObject("scripting.dictionary") 'Daten nach Datum-Fahrzeug-Beleg With Tabelle1 For Each rngC In Range(Cells(2, 17), Cells(Rows.Count, 17).End(xlUp)) strKEY = Join(Array(rngC, rngC.Offset(, -6), rngC.Offset(, -14)), cstrDELIM) If objDaten.exists(strKEY) Then arrItems = objDaten(strKEY) arrItems(0) = arrItems(0) + rngC.Offset(, -3) * 1 'Gewicht arrItems(1) = arrItems(1) + rngC.Offset(, 2) * 1 'Kosten1 arrItems(2) = arrItems(2) + rngC.Offset(, 3) * 1 'Kosten2 objDaten(strKEY) = arrItems Else objDaten(strKEY) = Array(rngC.Offset(, -3) * 1, rngC.Offset(, 2) * 1, rngC.Offset(, 3) * _ 1) End If Next rngC End With 'AusgabeArray erstellen ReDim arrDaten(1 To objDaten.Count, 1 To 6) For Each oObj In objDaten arrTmp = Split(oObj, cstrDELIM) For i = 1 To 3 arrDaten(n, i) = arrTmp(i - 1) arrDaten(n, i + 3) = objDaten(oObj)(i - 1) Next i Next oObj Tabelle2.Cells(2, 1).Resize(UBound(arrDaten), 6) = arrDaten End Sub

Hi
es wäre schön, wenn auch in deiner Beispieldatei auch schon in der Ausgangstabelle ein paar Daten vorhanden wären.
dann könnte man gleich überprüfen, ob das Makro richtig arbeitet.
hier mal ein ganz anderer Ansatz:

Sub test()
Dim i As Long
Dim Bereich As Range
Dim KopierSpalten
KopierSpalten = Array(17, 11, 3, 14, 19, 20)
For i = 0 To UBound(KopierSpalten)
Sheets(1).Columns(KopierSpalten(i)).Copy Sheets(2).Columns(i + 1)
Next
With Sheets(2)
.Select
.Range(.Cells(2, 1), .Cells(1, 2).End(xlDown)).Copy
.Cells(1, 1).End(xlDown).Offset(1, 0).PasteSpecial xlPasteAll
Selection.RemoveDuplicates Array(1, 2), xlNo
Selection.Copy .Cells(1, 1).End(xlDown).Offset(1, 0)
.UsedRange.Sort key1:=.Cells(1, 1), order1:=xlAscending, _
key2:=.Cells(1, 2), order1:=xlAscending, Header:=xlYes
For Each Bereich In .Columns(3).SpecialCells(xlCellTypeConstants).Areas
With Bereich(1).Offset(Bereich.Rows.Count)
.Resize(2).EntireRow.ClearContents
.Offset(0, 1).Resize(1, 3).Formula = _
"=Sum(" & Bereich.Offset(0, 1).Address(0, 0) & ")"
End With
Next
End With
End Sub

wenn du wissen willst, wie das makro arbeitet, gehe es im Einzelstep durch und schaue dir an, was in den Tabellenblättern passiert.
Gruß Daniel
ps: das Select und Selection ist in diesem Fall funktional notwendig.

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

316 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Dictonary oder Array?

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

316 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread