Discussion :

[RyuAutodidacte]

Hi Marc,
C'est clair, et j'en doute pas une seconde .
Pour les plus septiques, la démonstration que tu as faite est amplement suffisante et est, un très bon exemple.

PS : je suis rentré en grosse période à mon taf, donc je serai moins dispo en journée (plus le soir comme d'habitude)

Comme tout, je testerai la nouvelle demo

PS.2 : à l'occasion, si tu veux, il faudrait que je te montre 2 ou 3 fichiers sans vba.
Ryu

[Marc-L]

Dans le dernier code, je me suis amusé à remplacer des éléments de la formule pour calculer la seconde colonne
mais sinon on peut directement appliquer une formule propre à chaque colonne, plus simple pour les débutants …

[RyuAutodidacte]

re,
je viens de tester la nouvelle démo, sympa aussi en FormulaLocal

Du coup tu as fait tellement de version que ça va être difficile de trouver un autre principe de codage différent mais on va essayer ...

Donc pour corriger mon erreur du post #4 (code test2), j'ai fait un test3 à partir de test2 (ok ce n'est pas aussi élégant que tes codes )
pour la copie du résultat j'ai repris la même finalité que ton code avec les collections puisque ma version test2 était aussi avec une collection
PS : d'ailleurs j'aimerai bien que tu m’en dises plus sur le string :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

VA$(1 To C, 0)

Comme un tableau - pourquoi 0 et pas 1 par exemple (j'ai testé ça ne copie rien), encore des découvertes

mon nouveau code test3

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
34
35
36
Sub test3()
Dim VA, R&, DL1&, DL2&, DL&, Noms As New Collection, rw&
 
Cells(4).CurrentRegion.Clear
Application.ScreenUpdating = False
    DL1 = Range("A" & Rows.Count).End(xlUp).Row
    DL2 = Range("B" & Rows.Count).End(xlUp).Row
    DL = DL1 + DL2
 
    VA = Application.Transpose(Range("A1").CurrentRegion.Columns(1))
    ReDim Preserve VA(1 To DL)
 
    For x& = 1 To DL2
        VA(DL1 + x) = Range("B" & x).Value
    Next
 
    On Error Resume Next
    For R = 1 To DL1
        Noms.Add VA(R), VA(R)
    Next
    For R = DL1 + 1 To DL
        Noms.Add VA(R), VA(R)
        For i& = 1 To DL1
            If VA(i) = VA(R) Then Noms.Remove VA(R)
        Next
    Next
    On Error GoTo 0
 
    ReDim VF$(1 To Noms.Count, 0)
    For Each V In Noms:  rw = rw + 1:  VF(rw, 0) = V:  Next
    Cells(4).Resize(Noms.Count).Value = VF
 
Application.ScreenUpdating = True
    Set Noms = Nothing
 
End Sub

[Marc-L]

Ta procédure test3 fonctionne bien !

Sinon par défaut le premier indice d'une variable tableau est le zéro, voir Option Base …
Donc en déclarant par exemple VA$(1 To C, 1) il y aurait deux colonnes : 0 et 1 …
Donc par flemme comme je n'ai besoin que d'une colonne je choisis le 0 m'évitant un fastidieux 1 To 1 !

_________________________________________________________________________________________________________

La seule chose absolue dans un monde comme le nôtre, c'est l'humour. (Albert Einstein)

[RyuAutodidacte]

Hi,
c'est bien ce qui me semblait, mais j'en était pas sûr.
C'est la variable tableau déclaré en String et pas en Variant qui m'a dérouté.
je pensais que les pour tableaux la déclaration se faisait qu'en Variant
du coup cela doit alléger la procédure en mémoire je suppose !?

Edit : Quel est la meilleur méthode pour transformer un tableau a 2 dimension en 1 dimension ?

[Marc-L]

J'ai pu le définir en String vu l'affectation par boucle …

Par contre pour l'affectation directe des valeurs d'une plage de cellules dans une variable tableau,
là seul le type Variant est accepté et effectivement plus gourmand en mémoire …


Pour la transformation d'une variable tableau de deux dimensions à une seule,
tout dépend du résultat souhaité; c'est souvent via une boucle.

[RyuAutodidacte]

Pendant que tu écrivais j'en faisais justement des boucles
j'ai repris t'a méthode pour créer un tableau avec des colonnes choisies pour faire ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Tab2To1Dim()
Dim VA, V(), z&
    With Feuil2.Cells(1).CurrentRegion
            VA = Application.Index(.Value, Evaluate("ROW(1:" & .Rows.Count & ")"), [{1,2}])
 
        For y& = 1 To UBound(VA, 2)
            For x& = 1 To UBound(VA, 1)
                If VA(x, y) > "" Then
                    z = z + 1: ReDim Preserve V(1 To z)
                    V(z) = VA(x, y)
                    Debug.Print V(z)
                End If
            Next
        Next
    End With
End Sub

Autres solutions ??

[Marc-L]

Ligne n° 4 : VA = .Columns("A:B").Value …

Sinon comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub Col2ToDim1()
    With Feuil2.Cells(1).CurrentRegion.Columns("A:B").Cells
            ReDim VA$(1 To .Count)
        For Each V In .Value
            If V > "" Then N& = N& + 1: VA(N) = V: Debug.Print V
        Next
            ReDim Preserve VA(1 To N)
    End With
End Sub

[RyuAutodidacte]

- Ta nouvelle proposition

- Ligne n° 3 et 4 post #32(pour exemple), car ce que je trouve intéressant c'est de pourvoir rapatrier par la suite les données ayant la même correspondance dans une même colonne ou de les traiter avant de les remettre dans une colonne choisie

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
    With Feuil2.UsedRange
        VA = Application.Index(.Value, Evaluate("ROW(1:" & .Rows.Count & ")"), [{1, 4, 7}])

donc :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Tab2To1DimOK()
Dim VA, V(), z&
    With Feuil2.UsedRange
        VA = Application.Index(.Value, Evaluate("ROW(1:" & .Rows.Count & ")"), [{1, 4, 7}])
 
        For y& = 1 To UBound(VA, 2)
            For x& = 1 To UBound(VA, 1)
                If VA(x, y) > "" Then
                    z = z + 1: ReDim Preserve V(1 To z)
                    V(z) = VA(x, y)
                    Debug.Print V(z)
                End If
            Next
        Next
    End With
End Sub

Du coup j'avais un peu faussé la donne avec mon post précédent

[Marc-L]

Alors dans ce cas :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub ColTo1Dim()
    With Feuil2.UsedRange
        VA = Application.Index(.Value, Evaluate("ROW(1:" & .Rows.Count & ")"), [{1,4,7}])
    End With
        ReDim V$(1 To UBound(VA) * UBound(VA, 2))
    For Each W In VA
        If W > "" Then N& = N& + 1: V(N) = W: Debug.Print W
    Next
        ReDim Preserve V(1 To N)
End Sub

Variante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub ColumnsTo1Dim()
    With Feuil2.UsedRange.Rows
            ReDim VA$(1 To .Count * 3)
        For Each V In Application.Index(.Value, Evaluate("ROW(1:" & .Count & ")"), [{1,4,7}])
            If V > "" Then N& = N& + 1: VA(N) = V: Debug.Print V
        Next
    End With
            ReDim Preserve VA(1 To N)
End Sub

[RyuAutodidacte]

Terrible super bien optimisé, mathématique... on évite le redim dans la boucle et on l'allège avec l'utilisation d'un String

[Marc-L]

Merci !

[RyuAutodidacte]

Hi Marc,
j'ai voulu augmenté la difficulté du sujet/post
Au lieu de ne prendre en compte que 2 colonnes pour les noms, je suis passé à n colonnes (oui oui j'ai osé )
Les doublons sont pris en comptes et les noms répétitifs entre chacune des colonnes aussi
On peut ajouter autant de colonnes; normalement si j'ai bien fait mes tests, cela doit marcher (Ci-dessous, petit tableau sur lequel j'ai fait mes tests - Colonnes 1-3-5)

TOTO1		TOTO10		TOTO22
TOTO2		TOTO11		TOTO9
TOTO3		TOTO12		TOTO22
TOTO4		TOTO3		TOTO25
TOTO5		TOTO14		TOTO20
TOTO6		TOTO15		TOTO1
TOTO7		TOTO16
TOTO1		TOTO6
TOTO9		TOTO18
		TOTO19
		TOTO20
		TOTO14

Le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
34
35
Sub MultiColTo1Col_Test4()
Dim Nom As New Collection, SaveRemove As New Collection
 
    With Feuil3.UsedRange
        VA = Application.Index(.Value, Evaluate("ROW(1:" & .Rows.Count & ")"), [{1,3,5}])
    End With
            y& = 0
                On Error Resume Next
        For Each W In VA
            cpt_W& = cpt_W& + 1: If cpt_W > UBound(VA, 1) Then cpt_W = 1: y = y + 1 'ligne pour incrémentation de y = nb Col Tableau VA pris en compte
            If W > "" Then Nom.Add W, CStr(W)
            If y > 0 Then
                For z& = 1 To y
                    For x& = 1 To UBound(VA)
                        If W > "" Then
                            If VA(x, z) = W Then SaveRemove.Add W, CStr(W)
                        End If
                    Next
                Next
            End If
        Next
                On Error GoTo 0
    For Each W In SaveRemove
        Nom.Remove W
    Next
 
    Cells(9).CurrentRegion.Clear
    ReDim VF$(1 To Nom.Count, 0)
    For Each V In Nom:  rw& = rw& + 1:  VF(rw, 0) = V:  Next
    Cells(9).Resize(Nom.Count).Value = VF
 
    Set Nom = Nothing
    Set SaveRemove = Nothing
 
End Sub

Je pense qu'il y a certaines parties du code perfectibles, mais là je n'ai plus mes neurones

[Marc-L]

Salut Ryu !

Il y a juste la ligne n°15 me gênant car le test sur la variable W qui plus est au sein d'une boucle
a déjà été effectué dans la ligne n°11, je le vois plutôt comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
34
35
Sub MultiColTo1Col_Test4()
Dim Nom As New Collection, SaveRemove As New Collection
 
    With Feuil3.UsedRange
        VA = Application.Index(.Value, Evaluate("ROW(1:" & .Rows.Count & ")"), [{1,3,5}])
    End With
            y& = 0
                On Error Resume Next
        For Each W In VA
            cpt_W& = cpt_W& + 1: If cpt_W > UBound(VA, 1) Then cpt_W = 1: y = y + 1 'ligne pour incrémentation de y = nb Col Tableau VA pris en compte
            If W > "" Then
                    Nom.Add W, CStr(W)
                If y > 0 Then
                    For z& = 1 To y
                        For x& = 1 To UBound(VA)
                            If VA(x, z) = W Then SaveRemove.Add W, CStr(W)
                        Next
                    Next
                End If
            End If
        Next
                On Error GoTo 0
    For Each W In SaveRemove
        Nom.Remove W
    Next
 
    Cells(9).CurrentRegion.Clear
    ReDim VF$(1 To Nom.Count, 0)
    For Each V In Nom:  rw& = rw& + 1:  VF(rw, 0) = V:  Next
    Cells(9).Resize(Nom.Count).Value = VF
 
    Set Nom = Nothing
    Set SaveRemove = Nothing
 
End Sub

[RyuAutodidacte]

En effet mieux vaut éviter la répétition bien vu
merci pour la correction
J'ai essayé de faire le plus logique (pour moi) avec optimisation ce qui est pas évident.
Pour l'instant je n'ai pas visualisé une autre façon de faire... Une idée ?

Edit : Je me demande si autant de boucles étaient nécessaires pour faire le code ??
Car le but à la base de ce que j'avais en tête, était aussi de réduire un maximum les boucles.

[Marc-L]

Autre point à améliorer, la ligne n°16 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

                            If VA(x, z) = W Then SaveRemove.Add W, CStr(W): Exit For

Si la condition est vraie, pas besoin de continuer la boucle car W étant déjà inscrit pour être effacé …

Tu as raison pour les boucles, moins il y en a …
Par contre ici c'est assez rapide vu le peu de données et le travail en mémoire.

De mon côté, je partirais sur la base de Demo4 alimentant le dictionnaire avec la première colonne sans doublon
puis dédoublonner chaque colonne suivante pour intégration ou exclusion via deux collections annexes :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Demo4a()
            Dim COL(-1 To 1) As New Collection, C&, R&, V
    With Feuil3.UsedRange.Columns
            On Error Resume Next
        For Each V In .Item(1).Value
            If V > "" Then COL(0).Add V, V
        Next
        For C = 3 To 5 Step 2
            For Each V In .Item(C).Value
                If V > "" Then COL(1).Add V, V
            Next
            For Each V In COL(1)
                    W = COL(0)(V)
                COL(W > "").Add V, V
                    W = ""
            Next
                Set COL(1) = New Collection
        Next
            On Error GoTo 0
        For Each V In COL(-1):  COL(0).Remove V:  Next
            .Cells(1, 9).CurrentRegion.Clear
        If COL(0).Count Then
            ReDim V(1 To COL(0).Count, 0)
            For R = 1 To COL(0).Count:  V(R, 0) = COL(0)(R):  Next
            .Cells(1, 9).Resize(COL(0).Count).Value = V
        End If
    End With
        Erase COL
End Sub

Si par contre l'écart entre les colonnes est variable, (exemple: 1,4,6,11)
juste avec une variable tableau indiquant les numéros de colonnes :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Demo4b()
            Dim COL(-1 To 1) As New Collection, C&, R&, V
            VA = [{1,3,5}]
    With Feuil3.UsedRange.Columns
            On Error Resume Next
        For Each V In .Item(VA(1)).Value
            If V > "" Then COL(0).Add V, V
        Next
        For C = 2 To UBound(VA)
            For Each V In .Item(VA(C)).Value
                If V > "" Then COL(1).Add V, V
            Next
            For Each V In COL(1)
                    W = COL(0)(V)
                COL(W > "").Add V, V
                    W = ""
            Next
                Set COL(1) = New Collection
        Next
            On Error GoTo 0
        For Each V In COL(-1):  COL(0).Remove V:  Next
            .Cells(1, 9).CurrentRegion.Clear
        If COL(0).Count Then
            ReDim V(1 To COL(0).Count, 0)
            For R = 1 To COL(0).Count:  V(R, 0) = COL(0)(R):  Next
            .Cells(1, 9).Resize(COL(0).Count).Value = V
        End If
    End With
        Erase COL
End Sub

Et si vraiment une variable tableau regroupant les colonnes est nécessaire :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Demo4c()
            Dim COL(-1 To 1) As New Collection, C&, R&, V
    With Feuil3.UsedRange
        VA = Application.Index(.Value, .Parent.Evaluate("ROW(1:" & .Rows.Count & ")"), [{1,3,5}])
            On Error Resume Next
        For R = 1 To UBound(VA)
            If VA(R, 1) > "" Then COL(0).Add VA(R, 1), VA(R, 1)
        Next
        For C = 2 To UBound(VA, 2)
            For R = 1 To UBound(VA)
                If VA(R, C) > "" Then COL(1).Add VA(R, C), VA(R, C)
            Next
            For Each V In COL(1)
                    W = COL(0)(V)
                COL(W > "").Add V, V
                    W = ""
            Next
                Set COL(1) = New Collection
        Next
            On Error GoTo 0
        For Each V In COL(-1):  COL(0).Remove V:  Next
            .Cells(1, 9).CurrentRegion.Clear
        If COL(0).Count Then
            ReDim V(1 To COL(0).Count, 0)
            For R = 1 To COL(0).Count:  V(R, 0) = COL(0)(R):  Next
            .Cells(1, 9).Resize(COL(0).Count).Value = V
        End If
    End With
        Erase COL
End Sub

[RyuAutodidacte]

Hi Marc,
Merci beaucoup pour ton retour
comme je suis en bouclage je regarderai tout cela en détail ce soir

Bonjour Marc,
j'ai commencé à regarder tes nouveaux codes, mais j'ai pas fini de les analyser.
Ce qui est bien, c'est que je m’aperçois de ces petits détails qui font que je découvre à chaque fois de nouvelles façon de coder avec de nouvelles approches
et ça c'est TOP
Je ne visualise pas complètement ce qu'il se passe au milieu des codes, mais ça ne saurait tarder.
Je reviens vers toi dès que c'est OK
Merci encore

[Marc-L]

Tu as réussi ton algo avec seulement deux collections, j'en utilise une de plus !

[RyuAutodidacte]

Tu as réussi ton algo avec seulement deux collections, j'en utilise une de plus !

peut être, mais ce n'est pas le plus important , le plus important c'est de pouvoir évoluer
et grâce à toi, j'ai énormément progressé

Edit : de plus je suis très loin d'avoir ton niveau

Edit 2 : je me suis basé en bonne partie sur l'aide que tu m'as fourni (avec de la recherche internet aussi quand j'en ai besoin ou post du forum (que je lis souvent)) pour faire les codes

[RyuAutodidacte]

Bonsoir Marc,

j'ai enfin compris la partie qui me posé problème :
Mais où est donc passé ce Col(-1)
Et je me suis souvenu de ce que tu m'avais dis lors du post sur les doublons pour les valeurs de True et False => super ingénieux comme idée fallait y penser
Pour ma part ça ne me serait même pas venu à l'esprit


Je suis quand même revenu avec quelque chose de nouveau :

- Le but était de le faire avec une collection, une boucle, mais je n'ai pas trouvé ce qu'il me manquait dans mes recherches,
c'est à dire, je cherchais le moyen d'obtenir dans ma boucle, lors de la récupération de ma valeur V, le numéro d'index qui lui correspondait dans la collection (celle-ci se créant au fur et à messure);
si l'index de la valeur V dans la 2ème colonne du tableau est inférieur ou égal à la collection.count se trouvant dans la 1ère colonne du tableaux alors on Remove V dans la collection ( je sais pas si c'est assez claire)

- donc comme je n'ai pas trouvé le moyen d'obtenir mon numéro d'index directement (pour schématiser grossièrement : MaCol(V) = MaCol(IndexOf.MaCol("MaValeur"))) => Est ce possible ?? ,
j'ai dû faire un contournement me rajoutant une boucle !

Voilà le résultat :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub MultiColTo1Dim_New_OK()
Dim Nom As New Collection, y&, x&, c&
 
    With Feuil3.UsedRange
        VA = Application.Index(.Value, Evaluate("ROW(1:" & .Rows.Count & ")"), [{1,3,5}])
    End With
 
        y = 1
                On Error Resume Next
    For Each V In VA
        x = x + 1: If V > "" Then Nom.Add V, V
        If y > 1 Then
            For Each W In Nom
                i& = i& + 1: If i <= c And V = Nom(i) Then Nom.Remove V: c = c - 1
                If i = c Then Exit For
            Next
            i = 0
        End If
        If x Mod UBound(VA) = 0 Then y = y + 1: c = Nom.Count
    Next
                On Error GoTo 0
 
    Cells(9).CurrentRegion.Clear
    ReDim VF$(1 To Nom.Count, 0)
    For Each V In Nom:  rw& = rw& + 1:  VF(rw, 0) = V:  Next
    Cells(9).Resize(Nom.Count).Value = VF
 
    Set Nom = Nothing
 
End Sub

Edit : petite correction sur le code, en voulant trop simplifié en enlevant un retour à la ligne, le code ne marchait plus correctement sur la fin, là c'est ok