Option Explicit
Sub VergleichUndKopieren()
Dim wsGeneral As Worksheet
Dim wsMLT As Worksheet
Dim wsTest2 As Worksheet
Dim letzteZeileGeneral As Long
Dim letzteZeileMLT As Long
Dim i As Long, j As Long
Dim wertGeneral As String
Dim wertMLT As String
Dim gefunden As Boolean
Dim zielZeile As Long
Dim kopierBereich As Range
Dim letzteSpalteMLT As Long
Dim endZeile As Long
Dim k As Long
Dim kopiert As Boolean
Dim bereitsKopiert As New Collection ' Sammlung für bereits kopierte Werte
' Arbeitsblätter festlegen
Set wsGeneral = ThisWorkbook.Sheets("General Liste")
Set wsMLT = ThisWorkbook.Sheets("MLT")
Set wsTest2 = ThisWorkbook.Sheets("TEST2")
' Letzte Zeile in den Tabellen ermitteln
letzteZeileGeneral = wsGeneral.Cells(wsGeneral.Rows.Count, "I").End(xlUp).Row
letzteZeileMLT = wsMLT.Cells(wsMLT.Rows.Count, "D").End(xlUp).Row
' Schleife zum Vergleich der Werte
For i = 1 To letzteZeileGeneral
wertGeneral = wsGeneral.Cells(i, "I").value
gefunden = False
kopiert = False
' Wenn der Wert bereits kopiert wurde, überspringen
If IsInCollection(bereitsKopiert, wertGeneral) Then
GoTo SkipIteration
End If
' Durchsuchen des Arbeitsblatts "TEST2" nach dem Wert
For j = 1 To wsTest2.Cells(wsTest2.Rows.Count, "D").End(xlUp).Row
If wsTest2.Cells(j, "D").value = wertGeneral Then
gefunden = True
zielZeile = j ' Zielzeile festlegen, an der der kopierte Bereich eingefügt werden soll
Exit For
End If
Next j
' Wenn der Wert gefunden wurde
If gefunden Then
' Bereich bis zum nächsten leeren Wert in Spalte D von "MLT" bestimmen
endZeile = wsMLT.Cells(i, "D").End(xlDown).Row
letzteSpalteMLT = wsMLT.Cells(i, wsMLT.Columns.Count).End(xlToLeft).Column
' Kopierbereich festlegen
Set kopierBereich = wsMLT.Range(wsMLT.Cells(i, "D"), wsMLT.Cells(endZeile, letzteSpalteMLT))
' Kopierten Bereich in die Zielzeile einfügen
kopierBereich.Copy
wsTest2.Cells(zielZeile, "D").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
' Kopierten Wert zur Sammlung bereitsKopiert hinzufügen
bereitsKopiert.Add wertGeneral
kopiert = True
End If
SkipIteration:
' ' Wenn kein Wert gefunden wurde, eine Meldung anzeigen
' If Not gefunden Then
' MsgBox "Für den Wert in Zeile " & i & " von General wurde kein entsprechender Wert in TEST2 gefunden."
' End If
Next i
' Meldung anzeigen
MsgBox "Alle gefundenen Bereiche wurden kopiert und im Tabellenblatt TEST2 eingefügt."
End Sub
Function IsInCollection(col As Collection, val As Variant) As Boolean
On Error Resume Next
IsInCollection = Not col(val) Is Nothing
On Error GoTo 0
End Function
Hallo alle zusammen, ich komme leider mit meinem VBA Code nicht weiter. Wäre sehr sehr dankbar für eure Hilfe.
Ich hab in einer Datei drei Tabellen, die "<b>General-Liste</b>", "<b>MLT</b>" und "<b>TEST2</b>". In der <b>General-Liste</b> ist die eine große Ansammlung von Daten gegeben. Hier ist die Tabelle mit Werten befüllt. Für jede Zeile gehören die Werte zusammen, d.h. pro Zeile Daten welche zu einem Datensatz gehören. Hierbei steht in der Spalte I jeweils eine Nummer, also eine Art Nummerierung. In der Tabelle <b>MLT</b> sind ein paar dieser Werte raus kopiert und erweitert worden (mehrere Zeilen bilden einen Datensatz). Hier steht auch die Nummerierung in der Spalte D. Jetzt hab ich ein Code geschrieben, der die Tabelle <b>General-Liste</b> in einem anderen Format kopiert und einfügt. Der Code steht oben nicht drin aber der funktioniert zuverlässig.
Ich hab ein versuch gestartet und einen Code generiert (bzw. generieren lassen):
1. Die Werte in der Spalte I von der Tabelle "<b>General-Liste</b>" mit den Werten von der Tabelle "<b>MLT</b>" in der Spalte D sollen miteinander verglichen werden
2. Wenn diese gleich sind, soll der Code schauen bis welche Zeile und Spalte der Datensatz befüllt ist (klappt meistens gut) (das sind so 10 Spalten und 17 Zeilen pro Datensatz)
3. Dann soll das kopierte in die Tabelle "TEST2" eingefügt werden, aber genau da wo die Nummerierung schon steht --> also soll er die alte ersetzen.
Das Problem dabei, ist das hier nur eine Zeile zur Verfügung steht und das was eingefügt werden soll mehrere Zeilen hat.
Ein weiteres Problem ist, das der Code den gleichen Wert manchmal mehrmals einfügt, statt nur einmal.
Könnte mir da bitte bitte helfen?
Vielen Dank im Voraus.
Viele Grüße
Ali
|