Occurences colonnes dans variable

[kelvir]

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

[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))

[kelvir]

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

La cellule J2 a pour valeur 41

Etc...

[jfontaine]

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))

[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

[pijaku]

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

[kelvir]

C'est tout bon

Merci

Problème

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

[jfontaine]

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

[pijaku]

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...

[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

[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?

[kelvir]

Ouai nikel ca fonctionne

Merci

[kelvir]

Bonjour ,

Je relance malheuresement le post

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

[pijaku]

Bonjour,
Ta demande :

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?

[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.

[pijaku]

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

[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

[pijaku]

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...

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