VBA - Duplikate unter Bedingung filtern

Forumthread: VBA - Duplikate unter Bedingung filtern

03.09.2018 09:32:30

Aloha Community,
mit meinem Mini-Makro, zum Filtern von Duplikaten, stehe ich vor zwei Problemen.
Bitte helft mir, denn bisher konnte ich nichts Nützliches finden.
1. Wie kann ich mit diesem Makro nur Werte ohne Formatierung übertragen?
2. Ich würde gern nur die Duplikate (B) eines bestimmten Namens (A) filtern. Das Beispiel inkl. dem Makro habe ich angehangen.
https://www.herber.de/bbs/user/123704.zip
Schon mal vielen Dank für die Hilfe!

Sub Filter()
Range("D1:D20").ClearContents
Dim Q, Z As Range
Set Q = Range(Cells(1, 2), Cells(50, 2))
Set Z = Range("D1")
Q.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Z, Unique:=True
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: VBA - Duplikate unter Bedingung filtern

05.09.2018 20:53:02

Werner

Hallo,
zu 2. Meinst du so was?

Option Explicit
Sub Makro1()
Dim strName As String, loLetzte As Long, loLetzte1 As Long
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
strName = InputBox("bitte gesuchten Namen eingeben:", "Namen filtern")
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
loLetzte1 = .Cells(.Rows.Count, 4).End(xlUp).Row
If Not strName = vbNullString Then
.Range(.Cells(2, 3), .Cells(loLetzte, 3)).FormulaLocal = _
"=WENN(ZÄHLENWENNS(A:A;""" & strName & """;B:B;B2)>1;0;"""")"
.Range(.Cells(2, 3), .Cells(loLetzte, 3)).Value = .Range(.Cells(2, 3), _
.Cells(loLetzte, 3)).Value
.Range(.Cells(2, 4), .Cells(loLetzte1, 5)).ClearContents
.Range("$A$1:$C$" & loLetzte).AutoFilter Field:=3, Criteria1:=0
.Range("$A$1:$C$" & loLetzte).AutoFilter Field:=1, Criteria1:=strName
If .Cells(.Rows.Count, 1).End(xlUp).Row > 1 Then
.AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 1) _
.Columns("A:B").SpecialCells(xlCellTypeVisible).Copy
.Range("D2").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
.AutoFilterMode = False
.Columns("C:C").ClearContents
.Range("A1").Select
Else
MsgBox "Der gesuchte Name ist nicht vorhanden."
.AutoFilterMode = False
End If
End If
End With
Application.ScreenUpdating = True
End Sub

Bitte vor deinem eigentlichen Datenbereich noch eine Zeile mit Überschriften einfügen. Also in Zeile 1 Überschriften und die Daten dann ab Zeile 2. Zudem bin ich davon ausgegangen, dass die Spalte C frei (leer) ist. Dort schreibt das Makro eine Formel rein.
Gruß Werner

AW: VBA - Duplikate unter Bedingung filtern

06.09.2018 09:33:41

Vielen Dank für deine großartige Mühe!
Leider kann ich jedoch das Makro nicht verwenden.
In der Praxis habe ich eine Rohdatendatei (Quelldatei), die aus einer Datenbank exportiert wurde.
Nun ist das Ziel aus einer ganz bestimmten Spalte der Quelldatei alle Möglichkeiten auszulesen und in die Zieldatei ohne Duplikate und Formatierung zu schreiben.
Da dies kompliziert zu erklären und viel zu aufwendig zu modellieren ist, habe ich es hier stark abgespeckt.
In deinem Makro ist es notwendig den Namen einzugeben, nachdem gefiltert werden soll.
Wird dies getan schreibt er alle Werte in Spalte E zurück, die diesen Namen in Spalte A tragen.
Ziel ist jedoch die Werte ohne Duplikate rauszuschreiben. Also nur einmal, statt alle.
Das vorgeben des Namens darf nicht über eine Eingabemaske geschehen. Blöderweise habe ich das nicht erwähnt. In diesem Beispiel kann der erforderliche Name z.B. in Zelle H2 stehen. Je nachdem ob in H2 nun "Hugo" oder "Olga" steht soll er alle Zahlen (ohne Duplikate und Formatierung) z.B. in Spalte C, D oder E schreiben.
Sry, dass ich es nicht klarer formuliert habe.

AW: VBA - Duplikate unter Bedingung filtern

06.09.2018 11:41:36

Werner

Hallo,
das sollte kein Problem sein.
Nur nochmal zum Verständnis:
-Suchbegriff steht in H2
-du brauchst die Werte aus Spalte B zum Suchbergriff ohne Doppler
Das wäre dann Filter nach dem Wert aus H2. Dann das Filterergebnis aus Spalte B in den Zielbereich kopieren und dann auf den Zielbereich Daten-Duplikate entfernen anwenden.
Gruß Werner

AW: VBA - Duplikate unter Bedingung filtern

06.09.2018 14:32:35

Jepp, genau so ist es richtig.
Nur, dass die Daten vorm Filtern der Duplikate nicht geschrieben werden dürfen, da sie sonst das Zielformular zerstören. Nur das fertig gefilterte Ergebnis aus Spalte B, nach Spalte A, ohne Duplikate darf geschrieben werden.
Als I-Tüpfelchen muss ich dann noch versuchen, dass das Ergebnis das Format des Zielbereichs hat.
Die Formatierung darf also nicht mit übernommen werden.
PS: In der Praxis handelt es sich nicht um Zahlen, sondern um Texte - genau genommen Reklamationsgründe.
Nochmal vielen, vielen Dank für deine Mühen!

AW: VBA - Duplikate unter Bedingung filtern

06.09.2018 21:47:10

Werner

Hallo,
dann versuch jetzt mal das Makro.
- vorhandene Werte in Spalte D werden entfernt
- dann wird nach dem Wert in H2 gefiltert
- das Filterergebnis Spalte B wird in die Spalte Z kopiert (diese sollte frei sein)
- in Spalte Z werden die Duplikate entfernt
- das Ergebnis aus Spalte Z wird kopiert und in D2 eingefügt
- es werden nur die Werte eingefügt, keine Formatierungen
- Spalte Z wird geleert
Auch hier bitte wieder: Überschriften in Zeile 1, Daten dann ab Zeile 2

Option Explicit
Sub Makro1()
Dim strName As String, loLetzte As Long, loLetzte1 As Long
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
strName = .Range("H2")
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
loLetzte1 = .Cells(.Rows.Count, 4).End(xlUp).Row
If loLetzte1 > 1 Then
.Range(.Cells(2, 4), .Cells(loLetzte1, 4)).ClearContents
End If
If Not strName = vbNullString Then
.Range("$A$1:$C$" & loLetzte).AutoFilter Field:=1, Criteria1:=strName
If .Cells(.Rows.Count, 1).End(xlUp).Row > 1 Then
.AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 1) _
.Columns(2).SpecialCells(xlCellTypeVisible).Copy
.Range("Z1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
.AutoFilterMode = False
loLetzte1 = .Cells(.Rows.Count, 26).End(xlUp).Row
.Range(.Cells(1, 26), .Cells(loLetzte1, 26)).RemoveDuplicates Columns:=1, _
Header:=xlNo
loLetzte1 = .Cells(.Rows.Count, 26).End(xlUp).Row
.Range(.Cells(1, 26), .Cells(loLetzte1, 26)).Copy
.Cells(2, 4).PasteSpecial Paste:=xlPasteValues
.Columns(26).ClearContents
.Range("A1").Select
Else
MsgBox "Der gesuchte Name ist nicht vorhanden."
.AutoFilterMode = False
End If
End If
End With
End Sub

Gruß Werner

AW: VBA - Duplikate unter Bedingung filtern

07.09.2018 11:49:50

Wow, habe vielen, vielen Dank! Das Ergebnis ist genau das, was ich brauche.
Jetzt muss ich es nur für meine Rohdaten anpassen, da diese ja aus einer anderen Datei stammen und an andere Stelle in der Zieldatei geschrieben werden.
Ist es möglich in Spalte C zu den einzelnen Unikaten die Anzahl derer in den Rohdaten zu schreiben? Ich würde mir jetzt nur zu helfen wissen, indem ich einfach nachträglich jedes Unikat in den Rohdaten abgleiche und hochzähle. Oder geht das in einem Rutsch ins bestehende Makro zu implementieren?

Nachfrage

07.09.2018 12:31:36

Werner

Hallo,
ja sicher, wenn ich dich richtig verstanden habe.
Du möchtest am Ende in Spalte C die Anzahl haben, wie oft die jeweilige Zahl der Unikate in der Originalliste zum ausgewerteten Namen vorhanden ist?
Gruß Werner

AW: VBA - Duplikate unter Bedingung filtern

09.09.2018 16:23:52

Werner

Hallo,
hier deine Beispielmappe mit Makro:
https://www.herber.de/bbs/user/123842.xlsm
Gruß Werner

AW: VBA - Duplikate unter Bedingung filtern

10.09.2018 10:54:06

Werner, habe nochmals vielen Dank!
Das ist genau das was ich suchte.
Super!

Beliebteste Forumthreads (12 Monate)

VBA - Duplikate unter Bedingung filtern

Forumthread: VBA - Duplikate unter Bedingung filtern

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread