web-dev-qa-db-fra.com

Création d'une liste/d'un tableau dans Excel à l'aide de VBA pour obtenir une liste de noms uniques dans une colonne

J'essaie de créer une liste de noms uniques dans une colonne, mais je n'ai jamais compris comment utiliser ReDim correctement. Quelqu'un pourrait-il m'aider à résoudre ce problème et à expliquer comment cela est fait ou à mieux suggérer un autre moyen meilleur/plus rapide.

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

Mes données sont au format de: 

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

Donc, une fois qu’il a reçu le nom, il ne réapparaîtra jamais plus tard dans la liste.

A la fin, le tableau devrait être composé de: 

 Pile 
 Débordement 
 .Com
excelvbaexcel-vbaexcel-2007excel-2010
3
Ryflex

Vous pouvez essayer ma suggestion de contourner l'approche de Doug.
Mais si vous voulez vous en tenir à votre logique, vous pouvez essayer ceci:

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

Ceci utilise un tableau au lieu d'une plage.
Il utilise également la fonction Match au lieu d’un For Loop imbriqué.
Je n'ai cependant pas eu le temps de vérifier le décalage horaire.
Je vous laisse donc les tests.

4
L42

Vous n'avez pas besoin de tableaux pour cela. Essayez quelque chose comme:

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

S'il n'y a pas d'en-tête, changez en conséquence.

EDIT: Voici la méthode traditionnelle, qui tire parti du fait que chaque élément de la variable Collection doit avoir une clé unique:

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, voici le dictionnaire. Après avoir défini une référence à MS Scripting. Vous pouvez utiliser la taille du tableau avInput pour répondre à vos besoins.

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

Inspiré par VB.Net Generics List (Of Integer), j'ai créé mon propre module pour cela. Peut-être que vous le trouvez également utile ou que vous souhaitez étendre des méthodes supplémentaires, par exemple. pour supprimer à nouveau des éléments:

'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

Vous pouvez l'utiliser comme suit dans votre code:

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

Si vous avez besoin d’un autre type de liste, copiez simplement le module, enregistrez-le, par exemple. ListOfLong et remplacez tous les types Integer par Long. C'est tout :-)

1
Jochen H. W.

Je réalise que c’est une vieille question, mais j’utilise un moyen beaucoup plus simple. En général, je récupère simplement la liste dont j'ai besoin, soit en interrogeant, soit en copiant une liste existante, soit par quoi que ce soit, puis en supprimant les doublons. Nous supposerons pour cette réponse que votre liste se trouve déjà dans la colonne C, ligne 4, conformément à la question initiale. Cette méthode fonctionne pour toute liste de taille que vous avez et vous pouvez sélectionner l'en-tête oui ou non.

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