Excel - Per VBA eindeutige Werte einer Variablen zuweisen

Hallo Gemeinschaft,

habe folgende Tabelle - die hat natürlich noch mehrere Spalten und Zeilen - aber nur zum Grundverständnis

ich möchte, wenn ich so eine Tabelle habe eine Variable
Attributneu = ohne, Kragen, KragenBrust haben

also das in der Tabelle per VBA die doppelten Einträge nicht in die Variable kommen sondern nur einmal
Attribut Name 3
ohne
ohne
ohne
ohne
ohne
ohne
ohne
Kragen
Kragen
Kragen
Kragen
Kragen
Kragen
Kragen
Kragen Brust
Kragen Brust
Kragen Brust
Kragen Brust
Kragen Brust
Kragen Brust
Kragen Brust

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 1774930905

Url: https://administrator.de/forum/excel-per-vba-eindeutige-werte-einer-variablen-zuweisen-1774930905.html

Ausgedruckt am: 15.03.2025 um 01:03 Uhr

7 Kommentare

Neuester Kommentar

Stichwort Unique column values liefert dir diesbezüglich etliche Ergebnisse.

Such dir was aus

Neuere Excel-Versionen (WorksheetFunction.Unique() Methode)

1
2
3
4
5
6
7
Sub UniqueValues1()
    Dim uniques As Variant, i As Long
    uniques = WorksheetFunction.Unique(Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row))  
    For i = 1 To UBound(uniques)
        MsgBox uniques(i, 1)
    Next
End Sub

Andere Varianten

1
2
3
4
5
6
7
8
9
10
11
12
Sub UniqueValues2()
    Dim dic As Object, cell as Range, k as Variant
    With ActiveSheet
        Set dic = CreateObject("Scripting.Dictionary")  
        For Each cell In .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row)  
            If Not dic.Exists(cell.Value) Then dic.Add cell.Value, ""  
        Next
        For Each k In dic.Keys
            MsgBox k
        Next
    End With
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub UniqueValues3()
    Dim dic As Object, arr() As String, cnt As Long, cell as Range, i as long
    cnt = 0
    With ActiveSheet
        Set dic = CreateObject("Scripting.Dictionary")  
        For Each cell In .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row)  
            If Not dic.Exists(cell.Value) Then
                dic.Add cell.Value, ""  
                ReDim Preserve arr(cnt)
                arr(cnt) = cell.Value
                cnt = cnt + 1
            End If
            
        Next
        For i = 0 To UBound(arr)
            MsgBox arr(i)
        Next
    End With
End Sub

Oder zum direkten Entfernen der Duplikate in der Tabelle

1
ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes  

usw.
hier noch mehr Input
https://stackoverflow.com/questions/64614210/array-of-unique-values-in-a ...

G. @colinardo

Lieben Dank - wie würdest du nun eine Variable erstellen, in der diese Werte mit Komma getrennt stehen

Zitat von @jhaustein:

Lieben Dank - wie würdest du nun eine Variable erstellen, in der diese Werte mit Komma getrennt stehen

Arrays kannst du ganz einfach mit der Join Methode als String mit Delimiter zusammenfügen.

1
strResult = Join(arr,",")  

Oder auf die herkömmliche ganz primitive Art über FOR-Loop deinen String aneinander reihen.

1
2
3
4
5
Dim strResult as String
For i = 0 To UBound(arr)
       strResult = strResult & arr(i) & ","  
Next
strResult = Left(strResult,Len(strResult)-1)

Wenn du eh kein Array brauchst kannst du das letzte Verfahren auch direkt oben in den Methoden anwenden und auf die Arrays verzichten.

prima- lieben DAnk

hatte noch eine Frage

zu diesem code

1
2
3
4
5
6
7
Sub UniqueValues1()
    Dim uniques As Variant, i As Long
    uniques = WorksheetFunction.Unique(Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row))  
    For i = 1 To UBound(uniques)
        MsgBox uniques(i, 1)
    Next
End Sub

habe office 2016 - damit geht es noch nicht oder ?