AW: Tabellen vergleichen und Daten kopieren
21.07.2015 18:51:59
Klexy
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.