Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

2 Spalten auf Duplikate prüfen und koppieren

2 Spalten auf Duplikate prüfen und koppieren
14.12.2018 10:32:07
Martin
Hallo Zusammen;
das Forum konnte mir schon häufiger bei Problemen helfen, die ich über Google gesucht habe, leider finde ich nicht das passende für mein derzeitiges Problem und daher jetzt mal direkt ins Forum.
Ich soll eine Datei erstellen zum Abgleich zweier Datensätze mit alphanumerischen Codes. Hierzu habe ich, wie in der Beispieldatei zu sehen eine Mappe erstellt, die per SVERWEIS einen Abgleichdurchführt. Nur leider sollen doppelte Elemente nur einmal aus der Eingabetabelle gezogen werden.
Der Spezialfilter ist leider unbrauchbar, weil die Datei hinterher Leute benutzen, die wenig bis keine Ahnung haben von Excel. Daher wäre eine automatisierte Lösung per VBA wünschenswert.
Es soll also eine Prüfung der Spalte A auf Tabellenblatt "Eingabetabelle" auf Duplikate gemacht werden und dann der Datensatz ohne Duplikate auf das Tabellenblatt "Auswertung" kopiert werden. Das gleiche soll auch mit der Spalte D passieren.
Ich habe schon das ein oder andere gefunden, das meinem Problem nahe kommt, aber dann ist es nur eine Spalte, oder es werden nur die Duplikate ausgegeben. Und mein Verständnis für VBA ist eher bescheiden bis nicht nicht vorhanden.
Beispieldatei:
https://www.herber.de/bbs/user/126096.xlsm
Ich hoffe ich habe nichts vergessen und dass ihr mir helfen könnt.
Danke im Voraus für Eure Unterstützung.
Grüße,
Martin

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA zum Testen
14.12.2018 11:12:21
Fennek
Hallo,

Sub F_en()
Dim A As Object
Dim D As Object
Set A = CreateObject("Scripting.Dictionary")
Set D = CreateObject("Scripting.Dictionary")
With Sheets("Auswertung")
'Laden der bereits bearbeiteten Codes
'Spalte A
lr = .Cells(Rows.Count, 1).End(xlUp).Row
If lr > 1 Then
For i = 2 To lr
A.Item(.Cells(i, 1).Value) = vbNull
Next i
End If
'Spalte D
lr = .Cells(Rows.Count, 4).End(xlUp).Row
If lr > 1 Then
For i = 2 To lr
D.Item(.Cells(i, 4).Value) = vbNull
Next i
End If
End With
'Auswertung
With Sheets("Eingabetabelle")
lr = .Cells(Rows.Count, 1).End(xlUp).Row
If lr > 1 Then
For i = 2 To lr
If Not A.exists(.Cells(i, 1).Value) Then _
A.Item(.Cells(i, 1).Value) = vbNull
Next i
End If
'Spalte D
lr = .Cells(Rows.Count, 4).End(xlUp).Row
If lr > 1 Then
For i = 2 To lr
If Not D.exists(.Cells(i, 4).Value) Then _
D.Item(.Cells(i, 4).Value) = vbNull
Next i
End If
End With
With Sheets("Auswertung")
Cells(2, "G").Resize(A.Count) = Application.Transpose(A.keys)
Cells(2, "J").Resize(D.Count) = Application.Transpose(D.keys)
End With
Set A = Nothing
Set D = Nothing
End Sub
Die Ausgabe muss nach Prüfung angepasst werden.
mfg
Anzeige
AW: 2 Spalten auf Duplikate prüfen und koppieren
14.12.2018 11:29:45
Werner
Hallo Martin,
warum nicht einfach alle Daten kopieren und in der Zieltabelle dann mit RemoveDuplicates die Duplikate entfernen?
Public Sub ohne_Duplikate()
Dim loLetzte As Long
Application.ScreenUpdating = False
With Worksheets("Eingabetabelle")
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range(.Cells(2, 1), .Cells(loLetzte, 1)).Copy Worksheets("Auswertung").Cells(2, 1)
loLetzte = .Cells(.Rows.Count, 4).End(xlUp).Row
.Range(.Cells(2, 4), .Cells(loLetzte, 4)).Copy Worksheets("Auswertung").Cells(2, 4)
End With
With Worksheets("Auswertung")
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
Worksheets("Auswertung").Range("$A$2:$A$" & loLetzte).RemoveDuplicates Columns:=1, Header:= _
xlNo
loLetzte = .Cells(.Rows.Count, 4).End(xlUp).Row
Worksheets("Auswertung").Range("$D$2:$D$" & loLetzte).RemoveDuplicates Columns:=1, Header:= _
xlNo
End With
End Sub
Gruß Werner
Anzeige
AW: 2 Spalten auf Duplikate prüfen und koppieren
14.12.2018 12:18:04
Martin
Hallo Fennek und Werner,
danke für die schnellen Antworten. Die beiden Codes machen im großen und ganzen das was sie sollen.
Nur muss der Makro noch gestartet werden. Die Leute für die ich die ich diese Mappe erstelle haben wie gesagt nicht groß Ahnung von Excel und die Entwicklertools nicht aktiviert. Gibt es daher die Möglichkeit, dass der Makro automatisch ausgeführt werden kann, die Daten werden auch nicht einzeln eingegeben, sondern aus einem anderen System kopiert.
Die Lösung, dass die Datensätze erst kopiert und dann in der Zieltabelle erst auf Duplikate geprüft werden ist echt gut Werner. So ergeben sich noch mehr Auswertungsmöglichkeiten.
Grüße,
Martin
Anzeige
AW: 2 Spalten auf Duplikate prüfen und koppieren
14.12.2018 12:37:31
Werner
Hallo Martin,
und wo ist jetzt das Problem. Dann mach doch eine Schaltfläche auf das Tabellenblatt und weise dieser das Makro zu.
Auf einen Button zu klicken, werden die ja wohl hin kriegen.
Gruß Werner
AW: 2 Spalten auf Duplikate prüfen und koppieren
14.12.2018 13:19:42
Martin
Hallo Werner,
das Problem scheint wie so häufig vor dem Bildschirm zu sitzen. ;) Anscheinend bin ich in Excel doch noch nicht so fit wie ich dachte bzw. unterschätze noch immer die Möglichkeiten.
Schaltfläche ist eingefügt und zugewiesen. Jetzt ist alles gut.
Danke nochmal für schnelle und erfolgreiche Hilfe.
Grüße,
Martin
Gerne u. Danke für die Rückmeldung. o.w.T.
14.12.2018 13:20:45
Werner

305 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige