Office: Datensatzübertragung in neue Tabelle

cannondale_811 · 3. Januar 2020

Hallo,

mit meinen Einsteiger VBA-Kenntnissen komme ich leider aktuell bei dem folgendem Fall nicht weiter.
Aus der Tabelle "Objekte" sollen die Datensätze mithilfe eines Makros in die Tabelle "Rechnungen" übertragen werden.
Jedoch sollen für jede Objektnummer in "Rechnungen" jeweils 12 Zeilen angelegt werden und in die Spalte Zeitraum (Spalte Y in Beispieldatei) direkt 01.01.20, 01.02.20, 01.03.20, 01.04.20 usw. eingetragen werden.

Über Hilfe wäre ich sehr dankbar *Smilie

Danke und Grüße

:)

Hajo_Zi · 5. Januar 2020

das geht nicht, da eine XLSX Datei kein Makro enthalten kann.
Ich sehe keinen Grund eine Datei 2x zu speichern und den Code einzufügen.
Ich führe keine Liste unter welchem Dateinamen ich die Datei aus dem Forum gespeichert habe gespeichert habe.
Der Name steht ja im Beitrag.

Der Name einer hochgeladenen Mappe wird im Beitrag automatisch angezeigt, sodass es bei Verwendung von aussagekräftigen Namen leichter fällt, sie später im Ablageordner wiederzufinden und sie gedanklich einem bestimmten Thema zuzuordnen. Namen wie Muster*, Test*, Mappe*, Beispiel*, Fehler*, Kalender*, UserForm*, Forum* usw. sind so allgemein, dass eine Zuordnung zu einem Thema unmöglich gemacht wird.

ReginaR · 5. Januar 2020

Hi,
zur Umsetzung fehlen da noch ein paar Angaben: Soll jeweils nur ein Datensatz übertragen werden, oder sollen alle vorhandenen Datensätze untereinander in Rechnungen übertragen werden.
Soll grundsätzlich das aktuelle Jahr genommen werden, oder soll das Jahr abgefragt werden?

ReginaR · 5. Januar 2020

...ok, wer ganz nach links scrollt, erhält zumindest für die erste Frage eine Antwort *Smilie

Probier mal diesen Code, ergeht davon aus, dass immer das aktuelle Jahr genommen werden soll:
Code:

Public Sub Uebertrag()
Dim obj_wks_ziel As Worksheet
Dim obj_wks_quelle As Worksheet
Dim lng_letzte_zeile As Long
Dim lng_zeile As Long
Dim lng_monate As Long
Dim lng_spalte As Long
Set obj_wks_ziel = Worksheets("Rechnungen") ' Hier Zieltabellenblatt benennen
Set obj_wks_quelle = Worksheets("Objekte") ' Hier Quelltabellenblatt benennen

lng_letzte_zeile = obj_wks_ziel.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' Letzte zeile im Zielblatt ermitteln

lng_zeile = 2 ' Startzeile im Quellblatt

With obj_wks_quelle
Do Until .Cells(lng_zeile, 1) = "" ' Quellblatt ab Zeile 2 bis zur ersten leeren Zelle in A durchlaufen
For lng_monate = 1 To 12
For lng_spalte = 1 To 24
obj_wks_ziel.Cells(lng_letzte_zeile, lng_spalte) = .Cells(lng_zeile, lng_spalte)
Next
obj_wks_ziel.Cells(lng_letzte_zeile, 25) = DateSerial(Year(Date), lng_monate, 1)
lng_letzte_zeile = lng_letzte_zeile + 1
Next
lng_zeile = lng_zeile + 1
Loop
End With

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

cannondale_811 · 5. Januar 2020

Sorry, mein Fehler.
Hab die Datei als .xlsm abgespeichert und unter einem aussagekräftigerem Namen.

@ReginaR
Ja es sollen alle Datensätze untereinander aufgelistet und es soll das aktuelle Jahr genommen werden.
Vielen Dank für deinen Code, werde es gleich mal testen *Smilie

cannondale_811 · 6. Januar 2020

\@ReginaR

Vielen Dank nochmal, der Code funktioniert und liefert genau das, was ich mir vorgestellt habe *Smilie

Vielleicht kann mir jemand von euch noch bei einem weiteren Problem weiterhelfen.

In der Tabelle "Objekte" werden im Laufe des Jahres händisch neu hinzukommende Objekte eingetragen.
Ich würde gerne mit einem zusätzlichen Makro die Tabellen "Objekte" und "Rechnungen" vergleichen (anhand der Objektnummer?) und falls in "Objekte" neue Objektnummern vorhanden sind, diese nach "Rechnungen" übertragen.
Jedoch sollte die Anzahl der Zeilen pro Objektnummer vom Startdatum des Objektes (Spalte N, "von") abhängig gemacht werden.
Beispielsweise startet ein Objekt ab 01.05.2020, demnach würden dann für diese Objektnummer 8 Zeilen nach "Rechnungen" übertragen.

Danke schon mal für eure Hilfe!

Grüße

ReginaR · 6. Januar 2020

Hi,
ok, baue ich Dir ein.

ReginaR · 6. Januar 2020

... teste mal so:

Code:

Public Sub Uebertrag()
Dim obj_wks_ziel As Worksheet
Dim obj_wks_quelle As Worksheet
Dim lng_letzte_zeile As Long
Dim lng_zeile As Long
Dim lng_monate As Long
Dim lng_spalte As Long
Dim rng_gefunden As Range
Dim lng_start As Long
Set obj_wks_ziel = Worksheets("Rechnungen") ' Hier Zieltabellenblatt benennen
Set obj_wks_quelle = Worksheets("Objekte") ' Hier Quelltabellenblatt benennen

lng_letzte_zeile = obj_wks_ziel.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' Letzte zeile im Zielblatt ermitteln

lng_zeile = 2 ' Startzeile im Quellblatt

With obj_wks_quelle
Do Until .Cells(lng_zeile, 1) = "" ' Quellblatt ab Zeile 2 bis zur ersten leeren Zelle in A durchlaufen
Set rng_gefunden = obj_wks_ziel.Range("A:A").Find(.Cells(lng_zeile, 1))
If rng_gefunden Is Nothing Then
lng_start = Month(.Cells(lng_zeile, 14))
For lng_monate = lng_start To 12
For lng_spalte = 1 To 24
obj_wks_ziel.Cells(lng_letzte_zeile, lng_spalte) = .Cells(lng_zeile, lng_spalte)
Next
obj_wks_ziel.Cells(lng_letzte_zeile, 25) = DateSerial(Year(Date), lng_monate, 1)
lng_letzte_zeile = lng_letzte_zeile + 1
Next
End If
lng_zeile = lng_zeile + 1
Loop
End With

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

cannondale_811 · 6. Januar 2020

\@ReginaR
Vielen Dank! *Smilie

Jedoch wird mir hier beispielsweise bei einem Objekt mit Eintrag "31.12.2017" in der Spalte N ("von") nur eine Zeile in "Rechnungen" angelegt, obwohl für das Jahr 2020 12 Zeilen nötig wären.
Der Vergleich zwischen den Tabellen auf neue Objektnummern wäre denke ich in einem separaten Makro besser.
So würde ich das Makro mit dem Übertrag einmal am Anfang des Jahres ausführen und anschließend während des Jahres per separatem Makro die Aktualisierung durchführen.
Beispielsweise kommt am 01.03.20 Objekt A und 01.06.20 Objekt B hinzu, durch das neue Makro würden mir dann in "Rechnungen" für A 10 Zeilen und für B 7 Zeilen zu den bereits bestehenden hinzugefügt werden.
Könntest du mir helfen, das in eine separate Funktion zu schreiben?

Danke schon mal!

Grüße *Smilie

ReginaR · 6. Januar 2020

ok. In Ermangelung von Testdaten bin ich nicht auf die Idee von "Alt-Objekten" gekommen. Im folgenden Code wird für alle Objekte deren von-datum vor dem aktuellem Jahr liegt, die volle Anzahl von 2 Monaten ausgerollt:

Code:

Public Sub Uebertrag()
Dim obj_wks_ziel As Worksheet
Dim obj_wks_quelle As Worksheet
Dim lng_letzte_zeile As Long
Dim lng_zeile As Long
Dim lng_monate As Long
Dim lng_spalte As Long
Dim rng_gefunden As Range
Dim lng_start As Long
Set obj_wks_ziel = Worksheets("Rechnungen") ' Hier Zieltabellenblatt benennen
Set obj_wks_quelle = Worksheets("Objekte") ' Hier Quelltabellenblatt benennen

lng_letzte_zeile = obj_wks_ziel.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' Letzte zeile im Zielblatt ermitteln

lng_zeile = 2 ' Startzeile im Quellblatt

With obj_wks_quelle
Do Until .Cells(lng_zeile, 1) = "" ' Quellblatt ab Zeile 2 bis zur ersten leeren Zelle in A durchlaufen
Set rng_gefunden = obj_wks_ziel.Range("A:A").Find(.Cells(lng_zeile, 1))
If rng_gefunden Is Nothing Then
If Year(.Cells(lng_zeile, 14)) < Year(Date) Then
lng_start = 1
Else
lng_start = Month(.Cells(lng_zeile, 14))
End If
For lng_monate = lng_start To 12
For lng_spalte = 1 To 24
obj_wks_ziel.Cells(lng_letzte_zeile, lng_spalte) = .Cells(lng_zeile, lng_spalte)
Next
obj_wks_ziel.Cells(lng_letzte_zeile, 25) = DateSerial(Year(Date), lng_monate, 1)
lng_letzte_zeile = lng_letzte_zeile + 1
Next
End If
lng_zeile = lng_zeile + 1
Loop
End With

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ich bin nicht der meinung, dass man 2 Codes braucht. Mein Code prüft an dieser Stelle, ob es im Blatt Rechnungen schon Einträge für das Objekt gibt:

Code:

Set rng_gefunden = obj_wks_ziel.Range("A:A").Find(.Cells(lng_zeile, 1))
If rng_gefunden Is Nothing Then
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Nur wenn das nicht der Fall ist, werden für ein Objekt Einträge auf dem Rechnungsblatt vorgenommen. Es werden also keine bereits vorhandenen Rechnungseinträge überschrieben.

Bei 2 Codes müsstest Du noch einen Marker pflegen, an dem der Code neue Objekte erkennen kann.

cannondale_811 · 8. Januar 2020

\@ReginaR

Ja der korrigierte Code liefert mir jetzt genau das, was ich mir vorgestellt habe. Alle älteren Objekte werden mit 12 Zeilen übergeben und falls ich ein neues Objekt im Laufe des Jahres anlege, werden auch nur so viele Zeilen übergeben, wie benötigt.
Nochmals vielen Dank dafür, hast mir sehr weitergeholfen! *Smilie

ReginaR · 8. Januar 2020

prima, danke für die Rückmeldung.

Office: Datensatzübertragung in neue Tabelle

Datensatzübertragung in neue Tabelle

Datensatzübertragung in neue Tabelle

Datensatzübertragung in neue Tabelle

Datensatzübertragung in neue Tabelle

Datensatzübertragung in neue Tabelle - Similar Threads - Datensatzübertragung Tabelle

VBA - Datensätze ans Ende einer anderen Tabelle kopieren

(2021) Pivot-Tabelle: mehrere Spalten als eine behandeln

Resultat aus Filter in zweiten Tabellen Blatt filtern

Numerierung in eingefügt Tabellen in Word Dokument

Bedingte Formatierung funktioniert nicht

Filter()-Funktion: gefilterte Tabelle erweitern

Array aus Excel Tabelle einlesen Word VBA