Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1640to1644
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA - Duplikate unter Bedingung filtern

VBA - Duplikate unter Bedingung filtern
03.09.2018 09:32:30
RK
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

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

Betreff
Datum
Anwender
Anzeige
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
Anzeige
AW: VBA - Duplikate unter Bedingung filtern
06.09.2018 09:33:41
RK
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.
Anzeige
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
RK
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!
Anzeige
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
Anzeige
AW: VBA - Duplikate unter Bedingung filtern
07.09.2018 11:49:50
RK
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
Anzeige
AW: VBA - Duplikate unter Bedingung filtern
10.09.2018 10:54:06
RK
Werner, habe nochmals vielen Dank!
Das ist genau das was ich suchte.
Super!

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige