Anzeige
Archiv - Navigation
1352to1356
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

Werte aus Liste einmalig anzeigen VBA

Werte aus Liste einmalig anzeigen VBA
03.04.2014 11:23:31
Dominic
Hallo zusammen,
in diesem Thread habe ich folgenden VBA Code gefunden:
https://www.herber.de/forum/archiv/732to736/733154_Werte_aus_einer_liste_nur_einmal_anzeigen.html
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ziel As Range
If Cells(1, Target.Column).Value  "xxx1" Then Exit Sub
If Application.WorksheetFunction.CountIf(Rows(1), "xxx2")  1 Then
MsgBox ("Kein EINdeutiger Zielbereich vorhanden ('xxx2' in Reihe 1)")
Exit Sub
End If
Set Ziel = Rows(1).Find(what:="xxx2").Offset(1, 0)
Range(Cells(2, Target.Column), Cells(2, Target.Column).End(xlDown)).AdvancedFilter Action:=  _
_
xlFilterCopy, CopyToRange:=Ziel, Unique:=True
End Sub
Wie kann ich den VBA Code so anpassen, dass in meiner Tabelle "Datenbasis" die Spalte B2 bis 75.000 (oder auch variabel) die Werte ausliest und jeden Namen einmalig ausgibt in z. B. das Tabellenblatt "Daten" ab Zeile A1.
Im gesamten Tabellenblatt "Datenbasis" sind unzählige Kundentransaktionen hinterlegt, in Spalte B werden die jeweiligen Kundennamen aufgeführt. Ich brauch nun eine Liste dieser Kunden - dabei soll jeder Kunde natürlich nur einmalig aufgeführt werden.
Eine Pivot Tabelle ist keine Option. Es muss über ein solches Makro laufen.
Vielen Dank!
PS: Ich weiß wo ich das Makro im Klassenmodul hinterlege, aber wie starte ich dieses Makro bzw. rufe es auf? Habe da absolut keine Ahnung!

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Werte aus Liste einmalig anzeigen VBA
03.04.2014 11:47:25
Klaus
Hallo Dominic,
Nimm folgendes Makro. Unter xl2010 gibt es direkt die Option "remove Duplikate" ohne den Umweg über den Spezialfilter. Ich gehe davon aus, dass in "Daten!A1:Axxx" nichts steht. Falls doch, wird's vom Makro überschrieben. Davon abgesehen hast du ein "Worksheet-Change" Makro gefunden, das dir warscheinlich gar nichts nützt ...
Sub DerMakroname()
Dim lRow As Long
With Sheets("Datenbasis")
lRow = .Cells(.Rows.Count, 2).End(xlUp).Row
.Range("B2:B" & lRow).Copy
End With
With Sheets("Daten")
.Range("A1").PasteSpecial
.Range("$A$1:$A$" & lRow - 1).RemoveDuplicates Columns:=1, Header:=xlNo
End With
End Sub
Starten kannst du das über den Button "Makros" im Reiter "Entwicklerumgebung" (den du im Ribbon erst aktivieren musst). Oder ALT+F8, Makroname clicken und [ausführen]. Oder im VBA (wo du den Code hinkopiert hast) in den Code clicken und F5.
Grüße,
Klaus M.vdT.

Anzeige
AW: Werte aus Liste einmalig anzeigen VBA
03.04.2014 11:57:45
Dominic
Wow, perfekt. Es funktioniert einwandfrei! :)
Tausend Dank!

AW: Werte aus Liste einmalig anzeigen VBA
03.04.2014 12:24:49
Dominic
Klaus, eine Frage habe ich allerdings noch. Das wäre natürlich die Premium Lösung:
Gibt es eine Möglichkeit die im Tabellenblatt "Daten" aufgeführten Kunden dann auch direkt in
alphabetischer Reihenfolge aufzuführen? :)

jetzt mit Premium!
03.04.2014 12:41:57
Klaus
Hallo Dominic,
Premium kostet aber Extra! ;-)
Einfach das sortieren des Bereichs hinten an das vorhandene Makro anfügen.
Sub DerMakroname()
Dim lRow As Long
With Sheets("Datenbasis")
lRow = .Cells(.Rows.Count, 2).End(xlUp).Row
.Range("B2:B" & lRow).Copy
End With
With Sheets("Daten")
.Range("A1").PasteSpecial
.Range("$A$1:$A$" & lRow - 1).RemoveDuplicates Columns:=1, Header:=xlNo
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Range("$A$1:$A$" & lRow - 1), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
.Sort.SetRange .Range("A1:A12")
.Sort.Header = xlGuess
.Sort.MatchCase = False
.Sort.Orientation = xlTopToBottom
.Sort.SortMethod = xlPinYin
.Sort.Apply
End With
End Sub
Ich hab dafür Rekordercode übernommen und mich nicht groß ums optimieren geschert. Ungetestet kann ich dir aber sagen, dass Rudi's Lösung einen Beitrag weiter unten gerade bei großen Datenmengen um einiges schneller laufen wird.
Grüße,
Klaus M.vdT.

Anzeige
mini Bugfix AW: jetzt mit Premium!
03.04.2014 12:45:21
Klaus
Dominic,
mein Makro sortiert auch den leeren Bereich mit. Das ist zwar nicht schlimm, aber man kann ja trotzdem nachbessern:
Sub DerMakroname()
Dim lRow As Long
With Sheets("Datenbasis")
lRow = .Cells(.Rows.Count, 2).End(xlUp).Row
.Range("B2:B" & lRow).Copy
End With
With Sheets("Daten")
.Range("A1").PasteSpecial
.Range("$A$1:$A$" & lRow - 1).RemoveDuplicates Columns:=1, Header:=xlNo
.Sort.SortFields.Clear
lRow = .Cells(.Rows.Count, 2).End(xlUp).Row
.Sort.SortFields.Add Key:=.Range("$A$1:$A$" & lRow), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
.Sort.SetRange .Range("A1:A12")
.Sort.Header = xlGuess
.Sort.MatchCase = False
.Sort.Orientation = xlTopToBottom
.Sort.SortMethod = xlPinYin
.Sort.Apply
End With
End Sub
(Nach "RemoveDuplicates" wird erneut auf die letzte Zeile geprüft, das -1 fällt weg da jetzt der Versatz von Datenbasis!A2 nach Daten!A1 nicht mehr relevant ist)
Grüße,
Klaus M.vdT.

Anzeige
mini Bugfix AW: jetzt mit Premium!
03.04.2014 12:45:55
Klaus
Dominic,
mein Makro sortiert auch den leeren Bereich mit. Das ist zwar nicht schlimm, aber man kann ja trotzdem nachbessern. Ausserdem hatte ich vergessen, die "SetRange" anzupassen.
Sub DerMakroname()
Dim lRow As Long
With Sheets("Datenbasis")
lRow = .Cells(.Rows.Count, 2).End(xlUp).Row
.Range("B2:B" & lRow).Copy
End With
With Sheets("Daten")
.Range("A1").PasteSpecial
.Range("$A$1:$A$" & lRow - 1).RemoveDuplicates Columns:=1, Header:=xlNo
.Sort.SortFields.Clear
lRow = .Cells(.Rows.Count, 2).End(xlUp).Row
.Sort.SortFields.Add Key:=.Range("$A$1:$A$" & lRow), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
.Sort.SetRange .Range("A1:A" & lRow)
.Sort.Header = xlGuess
.Sort.MatchCase = False
.Sort.Orientation = xlTopToBottom
.Sort.SortMethod = xlPinYin
.Sort.Apply
End With
End Sub
(Nach "RemoveDuplicates" wird erneut auf die letzte Zeile geprüft, das -1 fällt weg da jetzt der Versatz von Datenbasis!A2 nach Daten!A1 nicht mehr relevant ist)
Grüße,
Klaus M.vdT.

Anzeige
AW: Werte aus Liste einmalig anzeigen VBA
03.04.2014 11:50:49
Rudi
Hallo,
dein Makro wird bei Änderungen an der Tabelle automatisch gestartet.
Andere Variante:
Sub Kunden_einmalig()
Dim oDic As Object, arrQ, i As Long
On Error GoTo ERRHDL
Application.EnableEvents = False
Set oDic = CreateObject("Scripting.dictionary")
arrQ = Range(Cells(1, 2), Cells(Rows.Count, 2).End(xlUp))
For i = 1 To UBound(arrQ)
oDic(arrQ(i, 1)) = 0
Next
With Sheets("Daten").Columns(1)
.ClearContents
.Cells(1, 1).Resize(oDic.Count) = _
WorksheetFunction.Transpose(oDic.keys)
End With
ERRHDL:
Application.EnableEvents = True
End Sub

Gruß
Rudi

Anzeige
Oder halt das Beispiel ein bisschen...
03.04.2014 12:10:01
EtoPHG
verallgemeinert und angepasst, Dominic
(hat den Vorteil, dass alles automatisch geschieht)
' Kopiert nur die eindeutigen Werte einer Spalte in ein anderes Blatt
' dessen Spaltenüberschrift in Zeile 1 genau gleich lautet
' Die Spalte muss lückenlos ohne Leerzeilen gefüllt werden.
' Anzupassen sind ggf. die Const Werte (sTitel, sZielBlatt)
Private Sub Worksheet_Change(ByVal Target As Range)
Const sTitel As String = "Kundenname"       ' Spaltenüberschrift (Zeile 1) in dieser  _
Tabelle
Const sZielBlatt As String = "Daten"        ' Blattnamen des Ziels
Dim Ziel As Range
If Cells(1, Target.Column).Value  sTitel Then Exit Sub
If Application.WorksheetFunction.CountIf(Worksheets(sZielBlatt).Rows(1), sTitel)  1 Then
MsgBox "Im Zielblatt '" & sZielBlatt & "' fehlt der Spaltentitel ",  _
vbExclamation
Exit Sub
End If
Set Ziel = Worksheets(sZielBlatt).Rows(1).Find(what:=sTitel)
Range(Cells(1, Target.Column), Cells(2, Target.Column).End(xlDown)).AdvancedFilter Action:= _
xlFilterCopy, CopyToRange:=Ziel, Unique:=True
End Sub
Gruess Hansueli
Anzeige

336 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige