HERBERS Excel-Forum - das Archiv

Thema: Vergleichen und Kopieren der gewünschten Werte

Vergleichen und Kopieren der gewünschten Werte
Ali
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 "General-Liste", "MLT" und "TEST2". In der General-Liste 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 MLT 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 General-Liste 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 "General-Liste" mit den Werten von der Tabelle "MLT" 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
AW: Vergleichen und Kopieren der gewünschten Werte
schauan
Hallöchen,

1)
Das Problem dabei, ist das hier nur eine Zeile zur Verfügung steht und das was eingefügt werden soll mehrere Zeilen hat.
--> ist das wirklich so? Wo sollen dann die anderen Zeilen hin?
--> oder, sollen dann auch die anderen Zeilen eingefügt und das vorhandene nach unten verschoben werden?
----> dann nutze "kopierte Zellen einfügen" Code kannst Du aufzeichnen und anpassen

2)
Ein weiteres Problem ist, das der Code den gleichen Wert manchmal mehrmals einfügt, statt nur einmal.
--> in Deiner Funktion schaust Du lediglich, ob Daten übergeben werden, nicht, was darin steht. Ob das so passt - scheint eventuell nicht so zu sein ...
--> wer weiß, was da drin steht bzw. was das bezwecken soll: wsGeneral.Cells(i, "I")

(--> allgemeiner Hinweis - schaue Dir mal die Wirkung von Keys in Collections an. )

AW: Vergleichen und Kopieren der gewünschten Werte
MCO
Moin Ali!

Wir kennen weder die Datenstruktur noch das Zielformat (1 Zeile).

Wenn du einen Bereich hast, der kopiert werden muss, aber in 1 Zeile soll, würde ich sagen, gehe jede Zelle des Bereiches durch und ordne sie einer Zelle in der Zielzeile zu. 
    spalte = 4

    

    For Each Zelle In Bereich

        wsTest2.Cells(zielZeile, spalte) = Zelle.Value

        spalte = spalte + 1

    Next Zelle

Gruß, MCO