Autres Erreur de compilation

[PORCHER]

Bonjour à tous,
Je viens vers vous pour une erreur de compilation Tableaux attendu.
Voici la macro

'Groupe
    Set NoDupes = Nothing
    Sheets("Rubriques").Select
    Range([B2], [B65536].End(xlUp)).Select
    On Error Resume Next
    a = Selection.Value
    For n = 1 To UBound(a, 1)
        NoDupes.Add a(n, 1), CStr(a(n, 1))
    Next n
    On Error GoTo 0
    For i = 1 To NoDupes.Count - 1
        For j = i + 1 To NoDupes.Count
            If NoDupes(i) > NoDupes(j) Then
                Swap1 = NoDupes(i)
                Swap2 = NoDupes(j)
                NoDupes.Add Swap1, before:=j
                NoDupes.Add Swap2, before:=i
                NoDupes.Remove i + 1
                NoDupes.Remove j + 1
            End If
        Next j
    Next i
    For X = 1 To NoDupes.Count
        Me.Combo_AjoGroupe.AddItem NoDupes(X)
    Next X

Erreur Ubound !
Si vous avez la solution merci de répondre

 

[Hasco]

Bonjour,

Si vous avez la solution merci de répondre

Mince, j'ai pété ma boule de cristal ce matin et je préfère siester plutôt que de tâtonner

Bon après-midi

 

[Softmama]

Bonjour,

Peut-être éviter le

Set Nodupes = Nothing

mais préférer un reDim à la place ?

 

[ChTi160]

Bonjour le Fil,
Je mettrais :

For i = 0 To NoDupes.Count - 1

Et

For X = 0 To NoDupes.Count-1

Mais comme dit par Hasco.....
Softmama :
"NoDupes" est une Collection . ReDim risque de ne pas passer.

Bonne fin de journée
Jean marie

 

[patricktoulon]

bonjour
comme ça vite fait (j'ai testé )
je me sert d'un tableau a une seule dim ( a moins que tu ai besoins de plusieurs colonnes c'est pas utile d'avoir une variable 2 dimension
le tri bulle(la méthode que tu utilise) peut être un peu long si tu a une longue liste
je te met donc aussi la fonction tri quicksort

Private Sub UserForm_Activate()
    Dim nodupes As New Collection, a&, t, t2()
    t = Range([B2], [B65536].End(xlUp)).Value
    On Error Resume Next
    For i = 1 To UBound(t)
        nodupes.Add t(i, 1), CStr(t(i, 1))
        'Debug.Print Err.Number
        If Err.Number = 0 Then a = a + 1: ReDim Preserve t2(1 To a): t2(a) = t(i, 1)
        Err.Clear
    Next
    On Error GoTo 0
    ComboBox1.List = OrderedArray(t2)
End Sub

Function OrderedArray(a, Optional gauc = -1, Optional droi = -1, Optional sens As Long = 0)  ' Quick sort
    Dim ref, g&, d&, temp, X
    droi = IIf(droi = -1, UBound(a), droi): gauc = IIf(gauc = -1, LBound(a), gauc)
    ref = a((gauc + droi) \ 2)
    g = gauc: d = droi
    Do
        Select Case sens    'choix du sens
        Case 0
            ' Pour un tri croissant
            Do While a(g) < ref: g = g + 1: Loop
            Do While ref < a(d): d = d - 1: Loop
        Case 1
            ' Pour un tri décroissant
            Do While a(g) > ref: g = g + 1: Loop
            Do While ref > a(d): d = d - 1: Loop
        End Select
        If g <= d Then
            temp = a(g): a(g) = a(d): a(d) = temp
            g = g + 1: d = d - 1
        End If
    Loop While g <= d
    If g < droi Then X = OrderedArray(a, g, droi, sens)
    If gauc < d Then X = OrderedArray(a, gauc, d, sens)
    OrderedArray = a
End Function

Bonne journée

 

[PORCHER]

Bonjour,
Merci infiniment PatrickToulon ca fonctionne très bien
Projet résolu
Bon lundi

 

[soan]

Bonjour PORCHER, le fil,

Merci infiniment PatrickToulon ca fonctionne très bien
Projet résolu

dans ce cas, tu peux marquer comme solution
le post #5 de patricktoulon ; exemple :

soan

 

[patricktoulon]

re
DE rien ravi pour toi
si tu tien a travailler quand même en variable tableau a 2 dim
je peux te donner la version quicksort multi dim