Tabellen vergleichen und Daten kopieren

Hallo Excel Spezialisten!!
Ich hoffe Ihr könnt mir helfen.
Ich habe folgenden Sachverhalt, in das Tabellenblatt Rohdaten werden jeden Monat neue Zahlen aus einer Auswertung kopiert. Anschließend möchte ich per VBA folgendes machen:
Die Spalte A aus Tabelle "Daten" und die Spalte A aus Tabelle "Rohdaten" sollen miteinander verglichen werden.
Werden Werte in den Rohdaten gefunden die in den Daten noch nicht vorhanden sind dann sollen die Werte aus den Spalten A und B von den Rohdaten kopiert und in die Daten am Ende angefügt werden.
Bei übereinstimmenden Werten, sollen die Inhalte aus den Rohdaten Spalten H, K und L in die Tabelle Daten übertragen werden und zwar dem jeweiligen Monat zugeordnet aus dem die Auswertung stammt (z.B. Januar wären es dann die Spalten H, I und J, Februar die Spalten M, N und O). Den jeweiligen Monat habe ich im Blatt Einstellungen per Formel definiert in B3.
Zur besseren Vorstellung habe ich eine Datei angefügt: https://www.herber.de/bbs/user/98946.xlsx
Wäre super wenn mir jemand helfen könnte.
LG Andi

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Vergleich() Dim Monat As Integer Dim i, j, lngLetzte As Long Dim bolFound As Boolean Monat = Sheets("Einstellung").Cells(3, 2) lngLetzte = Sheets("Daten").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row bolNotFound = False For i = 2 To Sheets("Rohdaten").Cells(Rows.Count, 1).End(xlUp).Row For j = 3 To Sheets("Daten").Cells(Rows.Count, 1).End(xlUp).Row If Sheets("Rohdaten").Cells(i, 1) = Sheets("Daten").Cells(j, 1) Then Sheets("Daten").Cells(j, Monat * 5 + 3) = Sheets("Rohdaten").Cells(i, 8) Sheets("Daten").Cells(j, Monat * 5 + 6) = Sheets("Rohdaten").Cells(i, 11) Sheets("Daten").Cells(j, Monat * 5 + 7) = Sheets("Rohdaten").Cells(i, 12) bolFound = True Exit For End If Next j If bolFound = False Then Sheets("Daten").Cells(lngLetzte, 1) = Sheets("Rohdaten").Cells(i, 1) Sheets("Daten").Cells(lngLetzte, 2) = Sheets("Rohdaten").Cells(i, 2) Sheets("Daten").Cells(lngLetzte, Monat * 5 + 3) = Sheets("Rohdaten").Cells(i, 8) Sheets("Daten").Cells(lngLetzte, Monat * 5 + 6) = Sheets("Rohdaten").Cells(i, 11) Sheets("Daten").Cells(lngLetzte, Monat * 5 + 7) = Sheets("Rohdaten").Cells(i, 12) lngLetzte = lngLetzte + 1 bolFound = False Else bolFound = False End If Next i End Sub

Tja...
Du: "in das Tabellenblatt Rohdaten werden jeden Monat neue Zahlen aus einer Auswertung kopiert"
Ich: "Wo werden die neuen Zahlen hinkopiert? Unten an die bestehende Liste dran? Oder wird die Liste immer wieder überschrieben?"
Du : "Die neuen Werte werden sollen immer unten an die bestehende Liste angehängt werden"
Wirklich?
Ich denke nein, denn deine 4. Antwort widerspricht dem.
Aber so könnte es gehen:


Sub Rohdaten_übertragen()
Dim zArray As Variant, i As Integer, j As Integer, Monat As Integer
Dim aTeil As String, aBezeichnung As String, aVerbrauch As Double, aKalk As String
Dim aPreis As Currency
Monat = Worksheets("Einstellung").Cells(3, 2).Value
' Array über alle schon vorhandenen Teilenummern:
zArray = Worksheets("Daten").Range("A2:A" & Worksheets("Daten").UsedRange.Rows.Count).Value
' erste mit Daten belegte Zeile im Blatt "Daten":
i = 3
' erste freie Zeile im Blatt "Daten":
n = Worksheets("Daten").Range("A3").End(xlDown).Row + 1
' alle Teilenummern schwarz:
Worksheets("Daten").Columns("A:B").Font.ColorIndex = xlAutomatic
For j = 2 To Worksheets("Rohdaten").Cells(Rows.Count, 1).End(xlUp).Row
aTeil = Worksheets("Rohdaten").Cells(j, 1).Value
aBezeichnung = Worksheets("Rohdaten").Cells(j, 2).Value
aVerbrauch = Worksheets("Rohdaten").Cells(j, 8).Value
aKalk = Worksheets("Rohdaten").Cells(j, 11).Value
aPreis = Worksheets("Rohdaten").Cells(j, 12).Value
If IsError(Application.Match(aTeil, zArray, 0)) Then ' neues Teil
Worksheets("Daten").Cells(n, 1) = aTeil
' neue Teilenummer blau:
Worksheets("Daten").Cells(n, 1).Font.Color = RGB(0, 0, 255)
Worksheets("Daten").Cells(n, 2) = aBezeichnung
Worksheets("Daten").Cells(n, 2 + Monat * 5 + 1) = aVerbrauch
Worksheets("Daten").Cells(n, 2 + Monat * 5 + 2) = aKalk
Worksheets("Daten").Cells(n, 2 + Monat * 5 + 3) = aPreis
n = n + 1
i = i + 1
Else ' vorhandenes Teil
Worksheets("Daten").Cells(i, 2 + Monat * 5 + 1) = aVerbrauch
Worksheets("Daten").Cells(i, 2 + Monat * 5 + 2) = aKalk
Worksheets("Daten").Cells(i, 2 + Monat * 5 + 3) = aPreis
i = i + 1
End If
Next
Worksheets("Daten").Select
Range("A3").End(xlDown).Select
MsgBox "Fertig"
End Sub

Wenn der Preis vom Makro nur mit 2 Dezimalstellen erfasst. In den Rohdaten werden 3 angezeigt und die Werte haben teilweise 10 Stellen hinter dem Komma. Wenn die Preise bei der Übertragung so präzise bleiben sollen, musst du die Zuweisung oben von "Currency" auf "Double" umstellen. Dann musst du allerdings erst die entsprechenden Spalten als Währung formatieren, was bisher nicht der Fall ist.
Praxishilfe: die neuen Teile werden jeweils blau gefärbt, damit man sie besser erkennt.

Beliebteste Forumthreads (12 Monate)

Tabellen vergleichen und Daten kopieren

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Tabellen vergleichen und Daten kopieren

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

301 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