Reprise du VBA blocage sur fonction simple

Version imprimable

26/07/2018, 14h56
gus02800

Reprise du VBA blocage sur fonction simple
Bonjour à tous et à toutes,

Voila ca fait quelques temps que je n'avais pas touché une ligne de code et aujourd'hui je bloque sur une petite fonction simple.

Objectif : déterminer le nombre de valeurs unique dans une colonne variable !

J'ai récupérer un bout de code qui fonctionne bien, cependant ici je compte le nombre de valeurs unique dans la colonne D, celle ci est variable et je n'arrive pas à l'écrire correctement, pouvez vous m'aider ?

En fait je souhaite que la colonne soit variable (suite à l'information donnée dans une UserForm).

En gros le "D" serait une variable "MaColonne"

Fonction :
Code:

1 2 3 4 5 6 7 On Error Resume Next For Each cel In Range("D1:D" & [D65000].End(xlUp).Row) unique.Add cel.Value, CStr(cel.Value) Next cel On Error GoTo 0 nbrFam = unique.Count - 1
Essai non concluant :

Code:

Range(MaColonne & "1:" & MaColonne & " & [ & MaColonne & 65000].End(xlUp).Row)

J'ai essayé d'autre facon également mais sans résultat ...

Merci par avance.

Cordialement

Bonjour gus

Code:

1
2
3
4
5
6
7
8
Dim unique As New Collection
    For Each cel In Range("D1:D" & [D65000].End(xlUp).Row)
        On Error Resume Next
        If cel.Value <> "" Then unique.Add cel.Value, CStr(cel.Value)
        On Error GoTo 0
    Next cel
    nbrFam = unique.Count - 1
MsgBox nbrFam

26/07/2018, 15h25
gus02800

Bonjour Patick,

Merci pour le retour rapide mais j'ai du mal me faire comprendre ...

En fait je souhaite que la colonne soit variable (suite à l'information donnée dans une UserForm).

En gros le "D" serait une variable "MaColonne"

Merci.

Bonjour,
Oublis le On Error ça n'a jamais été une bonne idée.

Code:

1
2
3
4
5
6
7
8
9
10
Sub test()
Dim Existe As String, Unique As New Collection, nbrFam As Long
For Each cel In Range("D1:D" & [D65000].End(xlUp).Row)
    If Not CBool(InStr(1, Existe, "©" & CStr(cel.Value) & "©")) Then
        Unique.Add cel.Value, CStr(cel.Value)
        Existe = Existe & "©" & CStr(cel.Value) & "©"
    End If
Next cel
nbrFam = Unique.Count
End Sub

Merci pour le conseil sur le OnError.

alors sur ce code, je ne vois pas non plus comment la colonne testée peu etre une variable.

cela serait trop simple mais le code donnerai plutôt quelque chose de ce style ... ! ATTENTION CE CODE NE FONCTIONNE PAS !
Code:

1 2 3 4 5 6 7 8 9 10 Sub test() Dim Existe As String, Unique As New Collection, nbrFam, ColonneVar As Long For Each cel In Range("ColonneVar1:ColonneVar " & [ColonneVar65000].End(xlUp).Row) If Not CBool(InStr(1, Existe, "©" & CStr(cel.Value) & "©")) Then Unique.Add cel.Value, CStr(cel.Value) Existe = Existe & "©" & CStr(cel.Value) & "©" End If Next cel nbrFam = Unique.Count End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub test()
MsgBox RetourneCollection("A").Count
MsgBox RetourneCollection("B").Count
MsgBox RetourneCollection("D").Count
End Sub
Function RetourneCollection(Col As String) As Collection
Dim Existe As String, Unique As New Collection, nbrFam As Long
For Each cel In Range(Cells(1, Col), Cells(Cells.Rows.Count, Col).End(xlUp))
    If CStr(cel.Value) <> "" Then
        If Not CBool(InStr(1, Existe, "©" & CStr(cel.Value) & "©")) Then
            Unique.Add cel.Value, CStr(cel.Value)
            Existe = Existe & "©" & CStr(cel.Value) & "©"
        End If
    End If
Next cel
Set RetourneCollection = Unique
End Function

Citation:

Envoyé par Cool

ATTENTION CE CODE NE FONCTIONNE PAS !

Citation:

J'ai récupérer un bout de code qui fonctionne bien, cependant je n'ai rien fait pour apprendre !