Zeilen in Excel auf Gleichheit vergleichen

Hallo an Alle,

ich habe folgendes Problem und würde mich freuen, wenn ihr mir helfen könnte ... (benötige eine VBA Lösung) ... :

Ich habe eine Tabelle "Tabelle1" mit mehreren Spalten und Zeilen. In der ersten Zeile sind die Spaltenüberschriften. Diese Zeile soll auch in Tabelle2 kopiert werden. Jetzt würde ich gerne Jede Zeile aus Tabelle1 miteinander vergleichen ... Wenn Zelle F2 und Zelle K2 gleich Zelle F3 und Zelle K3, dann in Tabelle2 kopieren .. usw.

In der Spalte F stehen die "Artikel" und in Spalte K die "Käufer" ... das bedeutet, dass ich gerne in Tabelle2 alle doppelten Zeilen haben möchte, wenn der Artikel und der Käufer gleich sind.

Vielen Dank für die Hilfe

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 272318

Url: https://administrator.de/contentid/272318

Ausgedruckt am: 15.11.2024 um 21:11 Uhr

6 Kommentare

Neuester Kommentar

Hallo abuelito,

Ich habe das letztens machen müssen, ohne VBA. Ich musste 2 Tabellen vergleichen und die identischen Sachen hat es mir dann in eine neue geschrieben, hier eine kleine Anleitung wie ich das gemacht habe.

Zuerst erstellt man eine neue Excel-Tabelle und geht unter „Data“ --> „From Other Sources“ --> „From Microsoft Query“ --> „Excel Files*“ auswählen und „OK“ --> Die 1. Datei auswählen --> „Sheet1“ auswählen und bis zum Ende weiter klicken, dann überträgt es die Tabelle --> Als nächstes wieder auf „Data“ --> „Connections“ -->“Properties“ --> „Definition“ --> Bei Commmand Text:
Select *
FROM `[DATEIPFAD1]`.`Sheet1$` [VARIABLE1]
inner join `[DATEIPFAD2].`Sheet1$` [VARIABLE2]
[VARIABLE1].[Spaltenbeschriftung]=[VARIABLE2].[Spaltenbeschriftung]

In der aktuellen Tabelle schreibt es dann die Einträge rein, welche bei beiden Tabellen vorkommen.

Zur Info, die Spaltenbeschriftung ist nicht A,B oder C sondern das, was auf der ersten Zeile hingeschrieben wurde.

Ich hoffe ich konnte dir wenigstens ein bisschen weiterhelfen!

Gruss Patrick

Hallo Patrick,

vielen Dank für Deine Hilfe. Leider benötige ich das Ganze in VBA.

Zudem vergleiche ich nicht 2 Tabellen, sondern nur Tabelle1 und schreibe in Tabelle2 nur die doppelten aus Tabelle1 hinein.

Grüße

Hallo abuelito,
nichts leichter als das, aber ich finde es ehrlich gesagt etwas schade das du von meinem letzten, vom Prinzip her sehr ähnlichen Code nicht sehr viel gelernt hast

copy_duplicate_rows_272318.xlsm

Sub MoveDuplicates()
    Dim ws1 As Worksheet, ws2 As Worksheet, cell As Range, dic As Object
    Set ws1 = Sheets(1)
    Set ws2 = Sheets(2)
    Set dic = CreateObject("Scripting.Dictionary")  
    With ws1
        'Überschriften der ersten Zeile in anderes Sheet kopieren  
        .Range("1:1").Copy ws2.Range("1:1")  
        'jede Zeile der Tabelle durchlaufen  
        For Each cell In .Range("A2:A" & .UsedRange.SpecialCells(xlCellTypeLastCell).Row)  
            'Vergleichstring für Dictionary  
            strCompare = cell.Offset(0, 5).Value & "|" & cell.Offset(0, 10).Value  
            If Not dic.Exists(strCompare) Then
                'existiert für die Zeile kein Eintrag füge ihn hinzu  
                dic.Add strCompare, ""  
            Else
                ' Eintrag existiert bereits kopiere Zeile in Zielsheet  
                cell.EntireRow.Copy ws2.Range("A" & ws2.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)  
            End If
        Next
    End With
End Sub

Grüße Uwe

Hallo Uwe,

vielen Dank für Deine Hilfe.

Ja, Dein Ansatz aus Deinem letzten Code habe ich versucht anzuwenden, aber leider ist es mir nicht gelungen.

Dein Hilfe oben klappt eigentlich, aber leider kopiert Dein Code nicht jede identische Zeile. Zur Zeit macht Dein Code folgendes:

Wenn ich in der Tabelle 2 Zeilen habe, in der Zelle F2 und K2 gleich Zelle F3 und K3 ist, dann kopiert er nicht beide Zeilen, sondern nur eine. Ich benötige aber alle Zeilen.

Wie gesagt, mit dem Code den Du mir das letzte Mal zugeschickt hast, habe ich es leider nicht hinbekommen.

Viele Grüße

Wenn ich in der Tabelle 2 Zeilen habe, in der Zelle F2 und K2 gleich Zelle F3 und K3 ist, dann kopiert er nicht beide Zeilen, sondern nur eine. Ich benötige aber alle Zeilen.

Auch kein Beinbruch

Sub MoveDuplicates()
    Dim ws1 As Worksheet, ws2 As Worksheet, cell As Range, dic As Object
    Set ws1 = Sheets(1)
    Set ws2 = Sheets(2)
    Set dic = CreateObject("Scripting.Dictionary")  
    With ws1
        'Überschriften kopieren  
        .Range("1:1").Copy ws2.Range("1:1")  
        'jede Zeile der Tabelle durchlaufen  
        For Each cell In .Range("A2:A" & .UsedRange.SpecialCells(xlCellTypeLastCell).Row)  
            'Vergleichstring für Dictionary  
            strCompare = cell.Offset(0, 5).Value & "|" & cell.Offset(0, 10).Value  
            
            If Not dic.Exists(strCompare) Then
                'existiert für die Zeile kein Eintrag füge ihn hinzu  
                dic.Add strCompare, cell.Address
            Else
                If dic.Item(strCompare) <> "" Then  
                    .Range(dic.Item(strCompare)).EntireRow.Copy ws2.Range("A" & ws2.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)  
                    dic.Item(strCompare) = ""  
                End If
                ' Eintrag existiert bereits kopiere Zeile in Zielsheet  
                cell.EntireRow.Copy ws2.Range("A" & ws2.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)  
            End If
        Next
    End With
End Sub

Grüße Uwe