wake-up-neo.com

Erstellen einer Liste/eines Arrays in Excel mithilfe von VBA, um eine Liste eindeutiger Namen in einer Spalte abzurufen

Ich versuche, eine Liste mit eindeutigen Namen in einer Spalte zu erstellen, aber ich habe nie verstanden, wie man ReDim korrekt verwendet. Könnte jemand mir helfen, dies abzuschließen und zu erklären, wie das gemacht wird, oder besser eine Alternative vorschlagen?.

Sub test()
    LastRow = Range("C65536").End(xlUp).Row
    For Each Cell In Range("C4:C" & LastRow)
        OldVar = NewVar
        NewVar = Cell
        If OldVar <> NewVar Then
            `x =...
        End If
    Next Cell
End Sub

Meine Daten haben das Format:

Stack
Stack
Stack
Stack
Stack
Overflow
Overflow
Overflow
Overflow
Overflow
Overflow
Overflow
Overflow
.com
.com
.com

Im Wesentlichen hat es einmal einen Namen, sobald es einmal in der Liste angezeigt wird.

Am Ende sollte das Array bestehen aus:

 Stack 
 Überlauf 
 .Com 
3
Ryflex

Sie können meinen Vorschlag für eine Umgehung in Dougs Ansatz ausprobieren.
Wenn Sie sich jedoch an Ihre Logik halten wollen, können Sie Folgendes versuchen:

Option Explicit

Sub GetUnique()

Dim rng As Range
Dim myarray, myunique
Dim i As Integer

ReDim myunique(1)

With ThisWorkbook.Sheets("Sheet1")
    Set rng = .Range(.Range("A1"), .Range("A" & .Rows.Count).End(xlUp))
    myarray = Application.Transpose(rng)
    For i = LBound(myarray) To UBound(myarray)
        If IsError(Application.Match(myarray(i), myunique, 0)) Then
            myunique(UBound(myunique)) = myarray(i)
            ReDim Preserve myunique(UBound(myunique) + 1)
        End If
    Next
End With

For i = LBound(myunique) To UBound(myunique)
    Debug.Print myunique(i)
Next

End Sub

Dies verwendet ein Array anstelle eines Bereichs.
Es verwendet auch die Match-Funktion anstelle eines verschachtelten For Loop.
Ich hatte jedoch keine Zeit, den Zeitunterschied zu überprüfen.
Also überlasse ich Ihnen die Prüfung.

4
L42

Sie brauchen dafür keine Arrays. Versuchen Sie etwas wie:

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

Wenn es keinen Header gibt, ändern Sie entsprechend.

BEARBEITEN: Hier ist die traditionelle Methode, die die Tatsache ausnutzt, dass jedes Element in einer Collection einen eindeutigen Schlüssel haben muss:

Sub test()
Dim ws As Excel.Worksheet
Dim LastRow As Long
Dim coll As Collection
Dim cell As Excel.Range
Dim arr() As String
Dim i As Long

Set ws = ActiveSheet
With ws
    LastRow = .Range("C" & .Rows.Count).End(xlUp).Row
    Set coll = New Collection
    For Each cell In .Range("C4:C" & LastRow)
        On Error Resume Next
        coll.Add cell.Value, CStr(cell.Value)
        On Error GoTo 0
    Next cell
    ReDim arr(1 To coll.Count)
    For i = LBound(arr) To UBound(arr)
        arr(i) = coll(i)
        'to show in Immediate Window
        Debug.Print arr(i)
    Next i
End With
End Sub
5
Doug Glancy

FWIW, hier ist die Wörterbuchsache. Nachdem Sie einen Verweis auf MS Scripting festgelegt haben. Sie können sich mit der Arraygröße von avInput an Ihre Bedürfnisse anpassen.

Sub somemacro()
Dim avInput As Variant
Dim uvals As Dictionary
Dim i As Integer
Dim rop As Range

avInput = Sheets("data").UsedRange
Set uvals = New Dictionary


For i = 1 To UBound(avInput, 1)
    If uvals.Exists(avInput(i, 1)) = False Then
        uvals.Add avInput(i, 1), 1
    Else
        uvals.Item(avInput(i, 1)) = uvals.Item(avInput(i, 1)) + 1
    End If
Next i

ReDim avInput(1 To uvals.Count)
i = 1

For Each kv In uvals.Keys
    avInput(i) = kv
    i = i + 1
Next kv

Set rop = Sheets("sheet2").Range("a1")
rop.Resize(UBound(avInput, 1), 1) = Application.Transpose(avInput)




End Sub
1
some guy

Inspiriert von der VB.Net Generics List (Of Integer) habe ich dafür ein eigenes Modul erstellt. Vielleicht finden Sie es auch nützlich oder möchten Sie für zusätzliche Methoden erweitern, z. Elemente wieder entfernen:

'Save module with name: ListOfInteger

Public Function ListLength(list() As Integer) As Integer
On Error Resume Next
ListLength = UBound(list) + 1
On Error GoTo 0
End Function

Public Sub ListAdd(list() As Integer, newValue As Integer)
ReDim Preserve list(ListLength(list))
list(UBound(list)) = newValue
End Sub

Public Function ListContains(list() As Integer, value As Integer) As Boolean
ListContains = False
Dim MyCounter As Integer
For MyCounter = 0 To ListLength(list) - 1
    If list(MyCounter) = value Then
        ListContains = True
        Exit For
    End If
Next
End Function

Public Sub DebugOutputList(list() As Integer)
Dim MyCounter As Integer
For MyCounter = 0 To ListLength(list) - 1
    Debug.Print list(MyCounter)
Next
End Sub

Sie könnten es in Ihrem Code folgendermaßen verwenden:

Public Sub IntegerListDemo_RowsOfAllSelectedCells()
Dim rows() As Integer

Set SelectedCellRange = Excel.Selection
For Each MyCell In SelectedCellRange
    If IsEmpty(MyCell.value) = False Then
        If ListOfInteger.ListContains(rows, MyCell.Row) = False Then
            ListAdd rows, MyCell.Row
        End If
    End If
Next
ListOfInteger.DebugOutputList rows

End Sub

Wenn Sie einen anderen Listentyp benötigen, kopieren Sie einfach das Modul und speichern Sie es unter z. ListOfLong und ersetzen Sie alle Typen Integer durch Long. Das ist es :-)

1
Jochen H. W.

Ich weiß, dass dies eine alte Frage ist, aber ich benutze einen viel einfacheren Weg. Normalerweise greife ich einfach die Liste, die ich brauche, entweder durch Abfrage oder Kopieren einer vorhandenen Liste oder was auch immer, und entferne dann die Duplikate. Wir gehen für diese Antwort davon aus, dass sich Ihre Liste bereits in Spalte C, Zeile 4 befindet, wie in der ursprünglichen Frage. Diese Methode funktioniert für jede beliebige Größenliste und Sie können die Kopfzeile ja oder nein auswählen.

Dim rng as range
Range("C4").Select
Set rng = Range(Selection, Selection.End(xlDown))
rng.RemoveDuplicates Columns:=1, Header:=xlYes
0
RollTideMike