Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA - Kopiere definierte Zellen nach Abgleich

VBA - Kopiere definierte Zellen nach Abgleich
weetabix
Hallo zusammen,
ich benötige bitte Hilfe für ein VBA Code:
Ausgangssituation:
Tabellenblatt 1:
Enthält ab D2:D100 Daten, bzw. zunächst leere Zellen. In D1 steht ein Datum, das aufsteigend D1, E1, F1 (...) vom 01.01 bis 31.12. weiter geht.
Tabelleblatt 2:
Enthält nur die Spalte A1:A100 mit teilweise gefüllten Zellen. In A1 steht ebenfalls ein Datum. Diese Daten werden bereits über eine Anweisung importiert. Das Datum richtet sich nach dem des importierten Materials, kann aber nur größer als das vorherige sein. Sobald ich die Daten importiert habe, ändern sich sowohl das Datum, als auch die Zellen.
Benötigter Code:
a)
Es soll das Datum aus Blatt 1 (D1 und folgende) mit dem vom Blatt 2 (A1) abgeglichen werden. Die Daten aus Blatt 2 (A2:A200) sollen daraufhin kopiert werden und direkt unter dem Bereich mit gleichen Datum in Blatt 1 eingefügt werden.
b) optional
Da nicht von jedem Tag Daten vorliegen, sollen nach Möglichkeit die Spalten dazwischen gelöscht werden.
Kann mir da jemand unter die Arme greifen?
Vielen Dank!
weetabix

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

Betreff
Benutzer
Anzeige
Bedingt Kopieren - aber etwas anders
21.03.2012 07:44:45
Erich
Hi Vorname,
die untenstehende Prozedur arbeitet nicht entsprechend deiner Beschreibung,
liefert aber wohl doch das gleiche Ergebnis.
Blatt 1 ("Ziel") ist zunächst ab Spalte D leer. Auch Zeile 1 ist nicht mit Daten bis zum 31.12. gefüllt.
Die Prozedur ermittelt das letzte bislang kopierte Datum (letzte beschriebene Spalte in Zeile 1 von "Ziel").
Wenn dieses Datum größer oder gleich dem Datum in "Quell" ist, kommt ein Abbruch mit Hinweis.
Sonst wird einfach Quell-Spalte A auf Ziel-Spalte D kopiert (incl. dem Datum in Zeile 1).
Effekt: In Ziel-Zeile 1 stehen nur Daten, zu denen auch kopiert wurde - dann ist später nichts zu löschen.
Du hast nicht geschrieben, was genau kopiert werden soll. Alles, nur die Werte oder auch die Formate?
So, und hier die Prozedur:

Option Explicit
Sub KopiereDatumNeu()
Dim cc As Long
With Sheets("Ziel")
cc = .Cells(1, .Columns.Count).End(xlToLeft).Column
If cc 
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich
Anzeige
AW: Bedingt Kopieren - aber etwas anders
21.03.2012 19:13:29
weetabix
Hallo Erich,
vielen Dank für die schnelle Rückmeldung!
Dein Code funktioniert einwandfrei, aber, wie du schon richtig vermutet hast, so sollen auch die gesamten Formatierungen mit kopiert werden. Kannst du mir hier auch noch mal helfen bitte? Damit wäre mein Problem eigentlich gelöst!
Aber - und rein interessehalber - sagen wir mal als zusätzlichen Lerneffekt für mich:
Hättest du einen Ansatz wie ich den Code aus a) hinbekomme? Bei Punkt b) hatte ich mich auch unklar ausgedrückt: Es soll nicht die gesamte Spalte gelöscht werden sondern nur die Zelle, in der das Datum steht. Also, sagen wir es steht in D1 und in H1 ein Datum (mit darunter liegenden Werten). Es sollen die dazwischen E1:G1(also nur die zurückliegenden, nicht ausgefüllten Daten) gelöscht werden.
Danke nochmal und viele Grüße,
Volker
Anzeige
AW: Bedingt Kopieren - aber etwas anders
21.03.2012 19:54:30
weetabix
Nochmal Hallo Erich,
völliger schwachsinn mein "aber" im ersten Absatz!
Im Code passt alles wunderbar - ich hatte nur einen Fehler in dem übetragenden Code, der die Formatierung nicht mitgenommen hat :-)
Also, wie gesagt - nur noch die andere Variante würde mich interessieren!
Danke!
Rückfragen
22.03.2012 01:08:45
Erich
Hi Volker,
jetzt ist mir gar nicht mehr klar, was du möchtest.
Was genau meinst du mit "Ansatz wie ich den Code aus a) hinbekomme"?
Das zu b) verstehe ich auch nicht. Wenn E1:G1 gelöscht werden, dann sind doch E2:G9999 ohnehin leer,
könnten also auch mitgelöscht werden, müssen aber nicht. Was macht da den Unterschied aus?
Was eigentlich meinst du mit "löschen" genau? Delete oder Clear oder ClearContents?
Und noch eine Frage - mehr zur Ablauflogik des Ganzen:
Wann sollte denn da in Zeile 1 gelöscht werden? Es werden doch täglich neue Daten übertragen.
Oder ist es vielleicht so, dass das Vortagesdatum gelöscht werden kann, weil dazu keine Daten mehr kommen können?
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich
Anzeige
AW: Rückfragen
22.03.2012 19:57:46
weetabix
Hi Erich,
danke für deine Rückmeldung.
Ich meinte es so, wie in Deinem letzten Satz beschrieben, also das das Vortagesdatum aus der Zelle im Blatt 1 gelöscht wird, die Spalte "dazwischen" aber leer bestehen bleibt:
A1 / B1 / C1 / D1
Datum / leer / leer / Datum
Daten / leer / lerr / Daten
Ich hoffe es ist verständlich ;-)
Aber ich hab noch eine Frage: Wie kann ich Deinen Code umschreiben, das das nur die Inhalte (Zahlen) aus der Quelle ins Ziel übertragen werden - also ohne Format?
Ich kenn das nur mit "pastespecial paste:xlvalues" - aber ich ich finde in dem Code gar keine "paste"!
Danke nochmal für Deine Hilfe!
VG,
Volker
Anzeige
neue Varianten und Löschen
23.03.2012 00:20:34
Erich
Hi Volker,
die folgenden Prozeduren setzen nicht voraus, dass in Zeile 1 ab D1 nach rechts alle Tage eines Jahres stehen,
lassen das aber zu.
Notwendig ist nur, dass in D1 der 1. Januar des betrachteten Jahres steht.
Wohin (in welche Spalte) kopiert wird, wird einfach aus dem Quell-Datum und dem 1.1 in D1 errechnet.
KopiereDatumNeu2 kopiert alles (auch Formeln und Formate),
KopiereDatumNeu3 überträgt nur die Werte.
Das Löschen in Zielzeile 1 ist unabhängig davon, kann auch separat aufgerufen werden.
Probiers halt mal aus:

Option Explicit
Sub KopiereDatumNeu2()        ' In D1 muss das Datum des 1. Januar stehen
Dim cc As Long
With Sheets("Ziel")
cc = Sheets("Quell").Cells(1, 1) - .Cells(1, 4) + 4
If cc  370 Then       ' 370 passt nur ungefähr
MsgBox "Datum in 'Quell' passt nicht zu den Zieldaten", _
vbCritical, "Abbruch"
Else
Sheets("Quell").Columns(1).Copy .Cells(, cc) ' mit Formeln und Formaten
End If
End With
End Sub
Sub KopiereDatumNeu3()        ' In D1 muss das Datum des 1. Januar stehen
Dim cc As Long, zz As Long
With Sheets("Quell")
cc = .Cells(1, 1) - Sheets("Ziel").Cells(1, 4) + 4
If cc  370 Then       ' 370 passt nur ungefähr
MsgBox "Datum in 'Quell' passt nicht zu den Zieldaten", _
vbCritical, "Abbruch"
Else
zz = .Cells(.Rows.Count, 1).End(xlUp).Row
' übertrage nur Werte (kein Copy)
Sheets("Ziel").Cells(1, cc).Resize(zz) = .Cells(1, 1).Resize(zz).Value
End If
End With
LoescheDaten      ' kann hier aufgerufen werden, muss aber natürlich nicht
End Sub
Sub LoescheDaten()            ' Das Datum des 1. Januar in D1 muss stehen bleiben
Dim cc As Long
With Sheets("Ziel")
For cc = 5 To Date - .Cells(1, 4) + 3   ' von Spalte E bis "gestern"
If Not IsEmpty(.Cells(1, cc)) And .Cells(.Rows.Count, 1).End(xlUp).Row = 1 Then _
.Cells(1, cc).ClearContents
Next cc
End With
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich
Anzeige

329 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige