Occurences colonnes dans variable

Version imprimable

15/09/2011, 08h28
kelvir

Occurences colonnes dans variable

Bonjour à tous,

Petite question concernant un problème que je n'arrive pas à résoudre

J'ai une colonne de la sorte :

J2:41
J3:41
J4:42
J5:42
J6:42
J7:43
J8:44
J9:44
J10:44
....

L'objectif est de réussir à sortir toutes les occurences de cette colonne ( dans l'exemple 41 ,42 ,43 ,44 ) et à les placer dans une variable

Des idées ?

Merci
15/09/2011, 08h37
jfontaine

Bonjour,

Tu peux utiliser une formule pour récupérer la partie a droite des :
Ici la colonne avec les données se trouve en A

Code:

=STXT(A1;CHERCHE(":";A1)+1;NBCAR(A1))
15/09/2011, 08h43
kelvir

Je viens de m'apercevoir que je me suis mal exprimé :mrgreen:

La cellule J2 a pour valeur 41

Etc...

ok,

une solution avec une variable tableau
Code:

1 2 3 4 5 6 Dim str() As Variant str = Range("A1:A8") MsgBox CStr(str(1, 1))

15/09/2011, 10h02
kelvir

Dans ce cas la la variable Str contient l'ensemble des valeurs de la colonne A .

Je souhaiterais uniquement les occurences

A1 41
A2 41
A3 41
A4 42
A5 43
A6 44

Je voudrais que la variable Str contienne uniquement 41 42 43 44

Bonjour tout le monde,

Partant d'une solution empruntée à Michel_m, je propose une solution par un dictionnaire :
Données à extraire situées dans la colonne A de la feuille 1

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub ExtraireValeursUniques()
Dim liste As Object
Dim fin As Long, cptr As Long, entree As String
Dim tablo
 
With Sheets(1)
     fin = .Columns("A").Cells(.Cells.Rows.Count, "A").End(xlUp).Row
     tablo = .Range("A1:A" & fin).Value
     Set liste = CreateObject("scripting.dictionary")
     For cptr = 1 To UBound(tablo)
          entree = tablo(cptr, 1)
          If Not liste.exists(entree) Then liste.Add entree, "x"
     Next
     MsgBox Join(liste.keys, "; ")
End With
End Sub

C'est tout bon

Merci ;)

Problème :cry:

La même chose sur la colonne J ne fonctionne pas...

D'ailleurs , comment compter le nombre de lignes de la variable tabresult ?

Merci

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Dim liste As Object
Dim tabresult As Variant
Dim fin As Long, cptr As Long, entree As String
Dim tablo
 
With Sheets(1)
     fin = .Columns("A").Cells(.Cells.Rows.Count, "A").End(xlUp).Row
     tablo = .Range("A1:A" & fin).Value
     Set liste = CreateObject("scripting.dictionary")
     For cptr = 1 To UBound(tablo)
          entree = tablo(cptr, 1)
          If Not liste.exists(entree) Then liste.Add entree, "x"
     Next
     tabresult = (liste.keys)
     Range("B1") = tabresult(1)
     Range("B2") = tabresult(2)
     Range("B3") = tabresult(3)
 
End With

Si le but est d'avoir les infos de la colonne A dans une variable String avec un séparateur ";" , ce code me semble bien plus simple
Code:

1 2 3 4 5 6 7 8 9 Dim i As Long Dim str As String For i = 1 To Range("A65536").End(xlUp).Row If str <> "" Then str = str & ";" str = str & Range("A" & i).Value Next i MsgBox str
Si ensuite, tu veux transférer str dans la colonne B
Code:

1 2 3 4 5 6 7 Dim strTab() As String strTab = Split(str, ";") For i = 0 To UBound(strTab) Range("B" & i + 1).Value = strTab(i) Next i

Salut
@Jérôme : le but est d'extraire les valeurs uniques d'une liste située en colonne J.

Je propose la solution ci-dessous, tout en précisant que, débutant en VBA, je ne connais pas du tout l'objet dictionary. Il doit bien exister une méthode de restitution (avec Item certainement), méthode que je ne connais pas. Je livre donc, dans l'immédiat, une solution avec une deuxième variable tableau intermédiaire, vais me pencher plus sérieusement sur le dictionary et reviendrais pour une solution plus jolie...
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 Sub ExtraireValeursUniques() Dim liste As Object Dim fin As Long, cptr As Long, entree As String Dim tablo Dim restit With Sheets(1) 's'occupe de la colonne J fin = .Columns("J").Cells(.Cells.Rows.Count, "J").End(xlUp).Row tablo = .Range("J1:J" & fin).Value Set liste = CreateObject("scripting.dictionary") For cptr = 1 To UBound(tablo) entree = tablo(cptr, 1) If Not liste.exists(entree) Then liste.Add entree, "x" Next restit = Split(Join(liste.keys, " ; "), " ; ") For cptr = 0 To UBound(restit) MsgBox restit(cptr) '.Range("K" & cptr + 1) = restit(cptr) Next End With End Sub
EDIT:
de retour après une petite recherche. Pour boucler sur les Items d'un dictionary, il faut déclarer une variable (num dans l'exemple) en type variant et boucler à l'aide de for Each par exemple :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 Dim liste As Object Dim fin As Long, cptr As Long, entree As String Dim tablo Dim num With Sheets(1) fin = .Columns("A").Cells(.Cells.Rows.Count, "A").End(xlUp).Row tablo = .Range("A1:A" & fin).Value Set liste = CreateObject("scripting.dictionary") For cptr = 1 To UBound(tablo) entree = tablo(cptr, 1) If Not liste.exists(entree) Then liste.Add entree, entree Next For Each num In liste MsgBox liste.Item(num) Next End With
Pour connaitre le nombre de valeurs contenues dans l'objet dictionary, il convient d'utiliser .count comme ceci :

Code:

MsgBox liste.Count

Vous dites...

15/09/2011, 13h08
kelvir

@pijaku

Le deuxième code fonctionne , néanmoins quand je change les A par J pour obtenir la liste des occurences dans la colonne J , j'ai cette erreur

Incompatibilité de type
15/09/2011, 13h21
pijaku

Ma faute, ma grande faute, ma très grande faute...

J'ai recopié bêtement un code sans chercher à analyser davantage...

Remplace la ligne :

Code:

fin = .Columns("J").Cells(.Cells.Rows.Count, "J").End(xlUp).Row

Par :

Code:

fin = .Range("J" & Rows.Count).End(xlUp).Row

ou par :

Code:

fin = .Columns("J").Cells(.Cells.Rows.Count, "A").End(xlUp).Row

ça va mieux non?
15/09/2011, 14h33
kelvir

Ouai nikel ca fonctionne

Merci

Bonjour ,

Je relance malheuresement le post :oops:

Le code suivant fonctionne pour rechercher les occurences sur une colonne (S)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
With Sheets("ListeArticle")
     's'occupe de la colonne I
    fin = .Range("S" & Rows.Count).End(xlUp).Row
    tablo = .Range("S3:S" & fin).Value
    Set liste = CreateObject("scripting.dictionary")
    For cptr = 1 To UBound(tablo)
        entree = tablo(cptr, 1)
        If Not liste.exists(entree) Then liste.Add entree, "x"
    Next
    restit = Split(Join(liste.keys, " ; "), " ; ")
    For cptr = 0 To UBound(restit)
 
 
        tabresult = (liste.keys)
 
 
    Next
 
 
 
  For i = 1 To liste.Count
 
'Affichage des dates
 
Sheets("Bilan").Cells(7, 3 + i) = tabresult(i - 1)
 
 
Next i

Je n'arrive malheuresement pas à le réitérer pour rechercher les occurences sur plusieurs colonnes

28/09/2011, 08h36
pijaku

Bonjour,
Ta demande :

Citation:

Je n'arrive malheuresement pas à le réitérer pour rechercher les occurences sur plusieurs colonnes

est bien trop imprécise...
Que souhaites tu faire exactement?
28/09/2011, 10h32
kelvir

Et bien dans l'exemple de code que je donne je fais une recherche d'occurences uniquement de S3 à S

Je souhaiterais faire en même temps par exemple H3:H , J3 : J , et même sur une colonne d'une autre feuille .

Pour l'instant je me contente de recopier l'ensemble des valeurs dans une seule colonne dans laquelle je viens chercher les occurences .
Cette solution ne me convient pas.

Citation:

Envoyé par kelvir

Je souhaiterais faire en même temps par exemple H3:H , J3 : J , et même sur une colonne d'une autre feuille

A adapter :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub test()
Dim liste As Object
Dim fin As Long, cptr As Long
Dim Lign As Byte
Dim entree As String
Dim tablo
Dim num
Dim Col
 
'boucle sur les colonnes A, D, E, F, G, H, I, J, L de la feuille "Feuil1"
'colonnes représentées ici par le Range("A1,D1:J1,L1") A ADAPTER
For Each Col In Worksheets("Feuil1").Range("A1,D1:J1,L1").Columns
    'extrait les occurences des valeurs uniques
    With Sheets("Feuil1")
        fin = .Columns(Col.Column).Cells(.Cells.Rows.Count, "A").End(xlUp).Row
        tablo = .Range(.Cells(1, Col.Column), .Cells(fin, Col.Column)).Value
        Set liste = CreateObject("scripting.dictionary")
        For cptr = 1 To UBound(tablo)
            entree = tablo(cptr, 1)
            If Not liste.exists(entree) Then liste.Add entree, entree
        Next
    End With
    'restitution feuil3 colonne A (Columns(1)) toutes les données les unes
    'sous les autres
    With Sheets("Feuil3")
        Lign = .Columns(1).Cells(.Cells.Rows.Count, "A").End(xlUp).Row + 1
        For Each num In liste
            .Cells(Lign, 1) = liste.Item(num)
            Lign = Lign + 1
        Next
    End With
Next Col
End Sub

28/09/2011, 11h48
kelvir

Merci pour ton aide.

J'ai l'impression que ca me sort les occurences pour chaque colonne.

Enfaite si j'ai ces valeurs :

H I J

5 4 5
6 5 9
5 10 4
9 6 7

Je souhaiterais ceci : 5 6 9 4 10 7

Citation:

J'ai l'impression que ca me sort les occurences pour chaque colonne.

Ben.... OUI! D'ou ma question qui te demandais ce que tu souhaites réaliser...

Citation:

Enfaite si j'ai ces valeurs :
H I J
5 4 5
6 5 9
5 10 4
9 6 7
Je souhaiterais ceci : 5 6 9 4 10 7

Une simple adaptation du code donné ci-dessus aurait suffit à ton bonheur...
La voici :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub test()
Dim liste As Object
Dim fin As Long, cptr As Long
Dim Lign As Byte
Dim entree As String
Dim tablo
Dim num
Dim Col
Set liste = CreateObject("scripting.dictionary")
'boucle sur les colonnes A, D, E, F, G, H, I, J, L de la feuille "Feuil1"
'colonnes représentées ici par le Range("A1,D1:J1,L1") A ADAPTER
For Each Col In Worksheets("Feuil1").Range("A1,D1:J1,L1").Columns
    'extrait les occurences des valeurs uniques
    With Sheets("Feuil1")
        fin = .Columns(Col.Column).Cells(.Cells.Rows.Count, "A").End(xlUp).Row
        tablo = .Range(.Cells(1, Col.Column), .Cells(fin, Col.Column)).Value
        For cptr = 1 To UBound(tablo)
            entree = tablo(cptr, 1)
            If Not liste.exists(entree) Then liste.Add entree, entree
        Next
    End With
Next Col
    'restitution feuil3 colonne A (Columns(1))
    With Sheets("Feuil3")
        Lign = .Columns(1).Cells(.Cells.Rows.Count, "A").End(xlUp).Row + 1
        For Each num In liste
            .Cells(Lign, 1) = liste.Item(num)
            Lign = Lign + 1
        Next
    End With
End Sub