Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
816to820
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
816to820
816to820
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Werte kopieren für besitmmte Posten

Werte kopieren für besitmmte Posten
08.11.2006 13:56:28
Daniel
Hallo!
Ich würde gerne ein Makro erstellen, das mir Werte aus bestimmten Zeilen eines Tabellenblatts in Zellen eines anderen Blatts kopiert. Leider kenne ich mich kaum aus in VBA.
Ich hoffe Ihr könnt mir helfen.
Es geht um Tabelle2 und Tabelle1, wobei Tabelle1 die Zieltabelle ist und Tabelle2 die Quelle.
In Tabelle2 stehen bestimmte Posten in Zeilen, die jeweils zwei wichtige Merkmale haben:
1. Ein alphanumerischer Code in Spalte A und
2. Ein Datum in Spalte F.
In Tabelle1 sind die jeweiligen Posten auch aufegführt. Allerdings sind dort andere informationen enthalten. Diese sollen nun durch Werte aus Tabelle2 ergänzt werden.
Man müsste zunächst nach dem jüngsten Datum in Tabelle2, Spalte F suchen (07.11. ist jünger als 06.11.). Nur die Zeilen mit diesem Datum spielen eine Rolle.
Dann müssen die dazugehörigen Posten in Tabelle1 gesucht werden, nachÜbereinstimmungen in den Spalten A (alphanumerischer Code) und Tabelle2 F und Tabelle1 B (Datum).
Sind hier die Posten identifiziert müssen nur noch der Wert aus Tabelle2, Spalte K nach Tabelle1 Spalte I kopiert werden.
Ab dem Punkt sollte ich alles weitere auch Alleine schaffen.
Wie muss so ein Code aussehen? Ich hoffe ich habe das einigermaßen verständlich rübergebracht.
Danke für Hilfe,
Daniel

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Werte kopieren für besitmmte Posten
09.11.2006 09:25:30
Daniel
Hallo nochmal,
wahrscheinlich antwortete bisher keiner, weil das etwas verwirrend beschrieben ist.
Das jüngste Datum findet mal wohl mit MAX(F:F).
Diese Zeilen müssten selektiert werden, wobei gesagt werden muss, dass die nicht fortlaufend in den Zeilen stehen.
Danach sucht man nach den Zeilen, die in Tabelle1 dieses Datum in Spalte B enthalten.
Nun müssen die Spalten A noch verglichen werden und bei den Übereinstimmungen setzt der Kopierprozess ein.
Ich habe mal eine Beispieldatei angehängt.
https://www.herber.de/bbs/user/38004.xls
Vielleicht ist es jetzt klarer wonach ich suche.
Beste Grüße,
Daniel
Anzeige
AW: Werte kopieren für besitmmte Posten
09.11.2006 09:30:11
Daniel
...natürlich noch offen. Vergessen anzuklicken.
AW: Werte kopieren für besitmmte Posten
09.11.2006 21:58:26
Gerd
Hallo Daniel,
mal als Einstieg.
Voraussetzung: keine Lücken in den Spalten(abwärts) zwischendrin.
Einschränkung: keine exakten Duplikate (A=A u. F=B)

Sub Test()
Dim datLast As Date, ZQ As Long, ZZ As Long, wsQ As Worksheet, wsZ As Worksheet
Set wsQ = ThisWorkbook.Worksheets("Tabelle2")
Set wsZ = ThisWorkbook.Worksheets("Tabelle1")
datLast = Application.WorksheetFunction.Max(wsQ.Columns(6))
For ZQ = 2 To wsQ.Cells(2, 6).End(xlDown).Row
If wsQ.Cells(ZQ, 6) = datLast Then
For ZZ = 2 To wsZ.Cells(2, 1).End(xlDown).Row
If wsQ.Cells(ZQ, 1) = wsZ.Cells(ZZ, 1) Then
If wsZ.Cells(ZZ, 2) = datLast Then
wsZ.Cells(ZZ, 9) = wsQ.Cells(ZQ, 11)
wsZ.Cells(ZZ, 10) = wsQ.Cells(ZQ, 12)
End If
End If
Next
End If
Next
End Sub

Gruß
Gerd
Anzeige
AW: Werte kopieren für besitmmte Posten
10.11.2006 08:46:02
Daniel
Hallo Gerd,
vielen Dank. In der Beispieldatei wird genau das gemacht was ich wollte.
Zwei Fragen:
Die Lücken in den Spalten dürfen in beiden Tabellen nicht vorkommen?
Die Einschränkung verstehe ich nicht. Was meinst du mit "keine exakten Duplikate"?
Wie baue ich die Messagebox ein, die kommen soll wenn die Zellen schon gefüllt sind?
In dem Fall soll das Makro diese Zeile überspringen und anschließend normal fortfahren.
Danke,
Daniel
AW: Werte kopieren für besitmmte Posten
10.11.2006 21:47:09
Gerd
Guten Abend Daniel!
Die Lücken in den Spalten dürfen in beiden Tabellen nicht vorkommen?
For ZQ = 2 To wsQ.Cells(2, 6).End(xlDown).Row
Von der Basiszelle "F2" liefert die integrierte Funktion "End(xlDown)" die letzte gefüllte Zelle mit Suchrichtung nach unten in Spalte "F". Wäre die Zelle "F4" z.B. leer und "F5" nicht, wäre die Schleife nach Zeile 3 bereits beendet. Alternativ könnte man "Cells(RowsCount,6).End(xlUp).Row" nehmen. Dann wird die letzte gefüllte Zelle in Spalte "F" von der letzten Zelle dieser Spalte aus, also von ganz unten mit Suchrichtung nach oben ermittelt. Lücken oberhalb wären dann unbeachtlich. Allerdings dürfte unterhalb des relevanten Bereichs kein Eintrag stehen, der nicht in die Prüfung einbezogen werden soll.
Die Einschränkung verstehe ich nicht. Was meinst du mit "keine exakten Duplikate"?
Falls in Tabelle2 "F3" und "F4" und in "A3" und "A4" die selben Werte stünden, würden in Tabelle1 bei erfüllten Bedingungen immer zunächst die Werte aus Tabelle2 Zeile 3 übernommen u. anschließend durch die Werte aus Tabelle 2 Zeile 4 überschrieben.
Wie baue ich die Messagebox ein, die kommen soll wenn die Zellen schon gefüllt sind?
In dem Fall soll das Makro diese Zeile überspringen und anschließend normal fortfahren.

Sub Test2()
Dim datLast As Date, ZQ As Long, ZZ As Long, wsQ As Worksheet, wsZ As Worksheet
Set wsQ = ThisWorkbook.Worksheets("Tabelle2")
Set wsZ = ThisWorkbook.Worksheets("Tabelle1")
datLast = Application.WorksheetFunction.Max(wsQ.Columns(6))
For ZQ = 2 To wsQ.Cells(2, 6).End(xlDown).Row
If wsQ.Cells(ZQ, 6) = datLast Then
For ZZ = 2 To wsZ.Cells(2, 1).End(xlDown).Row
If wsQ.Cells(ZQ, 1) = wsZ.Cells(ZZ, 1) Then
If wsZ.Cells(ZZ, 2) = datLast Then
If wsZ.Cells(ZZ,9)= Empty And wsZ.Cells(ZZ,10)= Empty then
wsZ.Cells(ZZ, 9) = wsQ.Cells(ZQ, 11)
wsZ.Cells(ZZ, 10) = wsQ.Cells(ZQ, 12)
Else
MsgBox "Kriterien in Tabelle1 Zeile " & ZZ & " erfüllt, Spalte I / J aber bereits gefüllt! "
End If
End If
End If
Next
End If
Next
End Sub

Gruß
Gerd
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige