Thema Datum  Von Nutzer Rating
Antwort
Rot Vergleichen und rein kopieren
17.04.2024 08:41:58 Ali
Solved
17.04.2024 11:06:09 Gast61779
NotSolved

Ansicht des Beitrags:
Von:
Ali
Datum:
17.04.2024 08:41:58
Views:
183
Rating: Antwort:
 Nein
Thema:
Vergleichen und rein kopieren

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


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Vergleichen und rein kopieren
17.04.2024 08:41:58 Ali
Solved
17.04.2024 11:06:09 Gast61779
NotSolved