abuelito
Goto Top

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

Content-Key: 272318

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

Ausgedruckt am: 28.03.2024 um 09:03 Uhr

Mitglied: Patrick-IT
Patrick-IT 19.05.2015 um 15:41:29 Uhr
Goto Top
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
Mitglied: abuelito
abuelito 19.05.2015 um 15:58:28 Uhr
Goto Top
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
Mitglied: colinardo
colinardo 19.05.2015 aktualisiert um 17:19:14 Uhr
Goto Top
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 face-wink
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
Mitglied: abuelito
abuelito 19.05.2015 um 17:40:53 Uhr
Goto Top
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
Mitglied: colinardo
Lösung colinardo 19.05.2015, aktualisiert am 20.05.2015 um 09:58:22 Uhr
Goto Top
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 face-smile
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
Mitglied: abuelito
abuelito 20.05.2015 um 09:58:26 Uhr
Goto Top
Hallo Uwe,

Du bist der Hammer und sowas von schnell !!!!

Vielen Dank, das hat super geklappt .. Danke!

Viele Grüße