Essai sur tableaux

Version imprimable

Voir 40 message(s) de cette discussion en une page

21/05/2013, 15h36
jijie

Bonjour patrick

ça avance ds ma tête, mais difficilement !

Tous d'abord avec ça :

Code:

tablo = Sheets(F).Range("a1:b" & Sheets(f).Range("a" & Rows.Count).End(xlUp).Row)

ça prend en compte seulement la feuille1

et ça :

Code:

tablo = Sheets(feuille(f)).Range("a1:b" & Sheets(f).Range("a" & Rows.Count).End(xlUp).Row)

la feuille 2 ! Je pense que ça écrase la feuille1 car le i se retrouve à 1 il faudrait que le i lorsqu'il se trouve sur feuille 2 s'additionne avec la valeur de la feuille1( je sais c'est tordu comme explication mais je vais chercher!)

Sinon c'est correct et sans doublon!

Tiens pour te donner encore plus mal a la tète

voici comme promis un exemplaire avec des tableau et sans dico

prévois de l'aspirine :mouarf:mais tu l'adis toi meme c'est pour exercice
Autant aller jusqu'au bout :aie::mouarf::aie:

allez c'est parti

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
 
'on ne peut redimensionner que le nombre de colonne dans un tableau a 2 dimensions
'on va donc transférer les données des cellules horizontalement dans le tablofinal
Option Base 1
Sub list_sans_doublons_par_tablo_sans_dico()
    Dim tablo As Variant
    Dim tablofinal()
    Dim presence As Boolean
    feuille = Array(1, 2)
    For F = 1 To UBound(feuille)
        tablo = Sheets(F).Range("a1:b" & Sheets(F).Range("a" & Rows.Count).End(xlUp).Row)
        For i = 1 To UBound(tablo)
            presence = False
            For e = 1 To n
                If tablofinal(1, e) = tablo(i, 1) Then
                    tablofinal(2, e) = tablofinal(2, e) + tablo(i, 2)
                    presence = True
                    GoTo suite
                End If
            Next e
            If presence = False Then
                ReDim Preserve tablofinal(2, 1 To e)
                tablofinal(1, e) = tablo(i, 1): tablofinal(2, e) = tablo(i, 2)
                e = e + 1: n = n + 1
            End If
suite:
        Next i
    Next F
    'on transpose le tablofinal horizontal dans un range vertical
    Sheets(4).Cells(1, 1).Resize(e - 1, UBound(tablofinal)) = Application.Transpose(tablofinal)
End Sub

tu constatera que l'on ne rempli plus le tableau verticalement mais horizontalement

tout simplement parce que on ne peut redimensionner que les colonnes avec "redim preserve " donc le principe c'est de le transposer par la suite verticalement

en gros les lignes deviennent les colonnes et les colonnes deviennent les lignes et vice et versa

bon étude hihihihihi:aie::mouarf:

Au plaisir

Re bonjour Patrick

Tu vas trop vite pour moi !!

Pour le moment je reste sur le post N° 16

Et là tu vas être épaté! Ds ce code, lorsque l'on est sur la feuille 2 le "i" repasse à 2 donc pour le tablo il passe aussi à 2 c'est pourquoi j'ai changé de variable pour le tablo car sinon les données de la feuil1 sont supprimées !

Donc 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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Option Explicit
 
 
'A jouter la référence à microsoft Scripting Runtiome
Option Base 1
Sub FusionFeuilles2èmeEssai()
    Dim sh3 As Worksheet
    Dim mDico As New Dictionary
    Dim feuille As Variant
    Dim F As Integer
    Dim i As Integer
    Dim E As Integer
    Dim a As Integer
 
    'on redimentionne le tableau par raport au nombre de ligne utilisée dans le sheets 1
    'ReDim tablofinal(Sheets(1).[a65536].End(xlUp).Row, 2)
    ReDim tablofinal(20, 3) ' je marque 20 pour me donner de la marge ds mon exemple!_
                              'par contre comment faire pour calculer la taille des deux feuilles
                              ' je note 3 pour augmenter ma compréhension
 
feuille = Array("feuil1", "feuil2")
    Set sh3 = ThisWorkbook.Sheets("Feuil3")
'on place les entetes dans la variable tablofinal
tablofinal(1, 1) = Sheets(1).Cells(1, 1).Text: tablofinal(1, 2) = Sheets(1).Cells(1, 2).Value: tablofinal(1, 3) = Sheets(1).Cells(1, 3).Value
 
    E = 2 ' ligne tablo: je ne garde pas i car sinon en cas de doublon
                          'sur le nom ça me donne une ligne en feuil3
 
    For F = 1 To UBound(feuille)
        'Lecture feuille
        With Sheets(feuille(F))
            i = 2    'Ligne 1 = Titre
            While .Cells(i, 1) <> ""
                            If Not mDico.Exists(.Cells(i, 1).Text) Then
                'Cas ou n'existe pas créé l'enregistrement
                    mDico.Add .Cells(i, 1).Text, .Cells(i, 2).Value
                    tablofinal(E, 1) = .Cells(i, 1).Text
                    tablofinal(E, 2) = .Cells(i, 2).Value
                    tablofinal(E, 3) = .Cells(i, 3).Value
                    E = E + 1
                              Else
                  For a = 1 To UBound(tablofinal) - 1
                  If tablofinal(a, 1) = .Cells(i, 1).Text Then
                  tablofinal(a, 2) = tablofinal(a, 2) + .Cells(i, 2).Text
                  tablofinal(a, 3) = tablofinal(a, 3) + .Cells(i, 3).Text
                  End If
                   Next
                       End If
                i = i + 1    'Ligne suivante
                        Wend
        End With
    Next
sh3.Cells(1, 1).Resize(UBound(tablofinal), 3) = tablofinal
 End Sub

Mon problème est la dimension du tablo "REDIM"

alors ?

PS c'est quoi "Option1" ?

Cordialement

sn dernier message sa devrait repondre a ta question

en fait c'est par ceque redim reserve ne peut redimentionner que les colonnes du tableau a 2 dimentions

dans un boucle
exemple

Code:

1
2
3
4
for z=1 to 10
redim preserve tablo(1 to z,2)' n'est pas possible (erreur!!!!!)
redim preserve tablo(2,1 to z)' ca c'est bon mais ca implique de travailler 'horizontalement dans le tableau 
next

par contre on peut faire

Code:

redim tablo(1 to z,10)

mais redim effacerait toute les données du tableau ce qui serait genant
puisque c'est le propre du travail que tu t"es fixé
car redim met a zero ton tableau en terme de valeur tu vois ce que ca donnerait dans une boucle 8O:roll::aie::scarymov:

et option base 1 en debut de module te permet de commencer le decompte a partir de "1" car un tableau a la base ca comence par 0,1,2,3 etc....
pareil pour les listbox dictionnaires etc....
l'element zero c'est le premier en fait voila tout et moi ca me plait pas voila

Par contre je comprend pas pourquoi tu persiste a travailler avec les cellules

Code:

While .Cells(i, 1) <> ""

quand tu a une liste de 5000 lignes j'espere que ta la cafetiere et les petits gateaux tu auras le temps de faire une pause 10 heures ou 4 heures :mouarf:

re
pour une entiere comprehension jai commenter chaque lignes de code pour l'exemplaire avec le dico
il fonctionne parfaitement avec plusieur feuille
voila le code

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
Option Base 1
'supprime les doublons et additionne les point pour les doublons
Sub Liste_Sans_Doublons_avec_dico_avec_addition_des_points() ' titre de la sub
    Set mondico = CreateObject("Scripting.Dictionary")    'on instancie le dictionnaire
    Dim tablo As Variant    'variable de type tableau qui contiendra les valeur de la plage de cellule de chaque sheets a chaque tour de boucle
    feuille = Array(1, 2)    'variable de type array qui contiendra l'index ou le nom de chaque feuille concernées
    For F = 1 To UBound(feuille)    'on boucle sur l'array contenant les nom de chaque feuille
'on inscrit les valeurs de la plage du sheets avec l'index de l'array dans le tablo
        tablo = Sheets(F).Range("a1:b" & Sheets(F).Range("a" & Rows.Count).End(xlUp).Row)
        For i = 1 To UBound(tablo)    'on boucle sur tout le tablo
            If Not mondico.Exists(tablo(i, 1)) Then    'si l'element du tablo existe pas
                mondico.Add (tablo(i, 1)), tablo(i, 2)    'on le met dans le dico les noms en cle et les points en item
            Else
                'Cas ou existe déjà Incrémente'on ajoute les points a l'item deja present  representant ce que contient(tablo(i,1)dans le dico
                If i > 1 Then mondico(tablo(i, 1)) = mondico(tablo(i, 1)) + tablo(i, 2)
            End If    ' fin de condition sur l'existance de l'element
        Next i    'fin de boucle tablo
    Next F    ' fin de boucle sur les feuilles
    With Sheets(3) ' dans la 3 eme feuille
        'on resize la plage a1 par le nombre de ligne du dico et sur 1 colonne on y colle les noms(colonne 1)
        .[a1].Resize(mondico.Count, 1) = Application.Transpose(mondico.Keys)
        'on resize la plage b1 par le nombre de ligne du dico et sur 1 colonne on y colle les points(colonne 2)
        .[b1].Resize(mondico.Count, 1) = Application.Transpose(mondico.Items)
    'traduction:
    'cellule(X,Y).resize(nombre de ligne dans le dico,1 colonne)=.........
        End With
    Set mondico = Nothing
End Sub

pour rendre la chose encore plus sympa il ne te reste plus qu'a en faire une fonction generique (tres interessant comme complement)
ET MAINTENANT EXEMPLE SANS DICTIONNAIRE COMMENTE AUSSI SUR CHAQUES LIGNES

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
34
35
36
37
38
39
40
41
42
'on ne peut redimentionner que le nombre de colonne dans un tableau a 2 dimentions
'on va donc tranférer les donées des cellules horizontalement dans le tablofinal
Option Base 1
Sub list_sans_doublons_par_tablo_sans_dico()
    Dim tablo As Variant 'variable pour les tableau de cellules
    Dim tablofinal() 'variable pour le tableau final qui contiendra  tout les element
    Dim presence As Boolean 'variable booleenne qui servira de tiket d'entrée pour les elements dans le tablo final
    feuille = Array(1, 2)
    For F = 1 To UBound(feuille) 'on boucle sur l'array contenant l'index ou le nom des des feuilles
        tablo = 0
        tablo = Sheets(F).Range("a1:b" & Sheets(F).Range("a" & Rows.Count).End(xlUp).Row)
        For i = 1 To UBound(tablo) 'on boucle sur tout les elements du tablo
 
            For E = 1 To n 'n etant le nombre d'item presents dans le tablofinal a chaque tour de boucle
               presence = False
               'si dans le tablofinal on trouve tablo (i,1)
               If tablofinal(1, E) = tablo(i, 1) Then
                    'on ajoute tablo(i,2) a tablofinal(2,e)
                    tablofinal(2, E) = tablofinal(2, E) + tablo(i, 2)
                    presence = True 'on met la booleenne a true
                    GoTo suite 'puisque l'on a trouver on sort de la boucle et on va au tablo(i,1) suivant
                End If
            Next E
            If presence = False Then
            'si la booleenne est resté a false ca veut dire que tablo(i,1) est absent de tablofinal(e,1)
             'on l'ajoute alors a tblofinal
                ReDim Preserve tablofinal(2, 1 To E) ' on preserve le nouvel element
                tablofinal(1, E) = tablo(i, 1): tablofinal(2, E) = tablo(i, 2) 'on l'inscrit dans le tablofinal
                E = E + 1: n = n + 1 'on incremente les variables pour le decompte et le compte tablofinal
                'car n nous sert a boucler sur le tablofinal.count et e sert a placer le nouvel element
            End If
suite: 'on atterrit ici si il y a doublon ,on a donc sauter les lignes ou sinscrivent les données du nouvel element
        Next i
    Next F
    'on transpose le tablofinal horizontal dans un range vertical
    Sheets(4).Cells(1, 1).Resize(E + 3, UBound(tablofinal)) = Application.Transpose(tablofinal)
'traduction:
'Sheets(4).Cells(1, 1).Resize(le nombre de colonne du tablofinal,le nombre de lignes du tablofinal)=......
'comme tu peut le voir j'ai inverser les colonne du tablofinal avec les ligne de la plage de cellule de reception
 
 
End Sub

bonne etude;):ccool:

Salut Patrick,

J'ai regarder ton dernier post, et l'ai adapter sur le fichier joint!

Pour l'utiliser commence sur la feuil5 puis 4 et enfin 3
(sur la 2 il n'y a rien pour diminuer le poids du fichier 38000 lignes en feuil1!! )

Tes codes sont super rapides ! impressionnant! par contre j'ai pas saisi cette partie :
Code:

1 2 3 4 5 'on transpose le tablofinal horizontal dans un range vertical Sheets(4).Cells(1, 1).Resize(E + 3, UBound(tablofinal)) = Application.Transpose(tablofinal) 'traduction: 'Sheets(4).Cells(1, 1).Resize(le nombre de colonne du tablofinal,le nombre de lignes du tablofinal)=...... 'comme tu peut le voir j'ai inverser les colonne du tablofinal avec les ligne de la plage de cellule de reception
Si je comprends bien les codes de dernier post ne peuvent gerer que 2 colonnes!?

C'est pourquoi le système tablo à 2 voir +++ sont intéressants !

Ds le module 1 du fichier joints on ne serait pas limité, il serait possible d'additionner les code INSEE de la feuille1 et également le code postal (on est bien d'accord que ça ne sert à rien, mais c'est pour l'exercice) Alors dit moi ou je M....... sur ce code pour qu'il soit si lent!

Merci pour le coup de main !:ccool:

re
pour les lignes de code que tu a pas compris

j'ai essayer de te l'expliquer précédemment mais visiblement je ne suis pas un tres bon pédagogue lol...

alors en gros

un tableau a 1 colonne peut être dimensionné dynamiquement dans une boucle(redim preserve tablo(1 to X))

un tableau a plusieurs 1,2 ou 30 si tu veux ne peut avoir que les colonnes de redimensionnables mais les les ligne non!!!!

c'est assez gênant quand on veut mettre une plage de plusieur ligne et plusieur colonnes et que l'on peut le redimensionner dynamiquement dans une boucle for

donc je répète

ca c'est pas bon ca ne marche pas
Code:

1 2 3 redim preserve tablo(1 to X,Y) ou redim preserve tablo(1 to X,1 to Y)
par contre

Code:

redim preserve tablo(5,1 to X)

c'est bon mais ca implique un tablo a 5 lignes

alors le but et de transposer dans l'autre sens
un plage de cellules de 20 lignes sur 3 colonnes par exemple
dans la boucle ca donnera
Code:

1 2 3 4 5 6 for i = 1 to 20'on boucle sur les ligne des cellules redim preserve tablo(3, 1 to 20) tablo(1,i)=lacellule ligne i colonne 1 tablo(2,i)=lacellule ligne i colonne 2 tablo(3,i)=lacellule ligne i colonne 3 next
pourtant tablo(1,i) veut dire tablo (ligne1,colonne i)

en fait on inverse les lignes et colonnes du sheets au tableau

ensuite avec application.transpose sur un
cells(1,1).resize(i,3)=trans.......

le chiffre 3 dans cet exemple c'est le nombre de colonne du sheets que l'on prend en compte
et le nombre de ligne du tableau

est ce plus clair la ??????

23/05/2013, 19h51
nibledispo

1 pièce(s) jointe(s)

essai sur tableau

bonjour Patrick,

la version sans dico ne fonctionne apparemment pas correctement.

je te joins un fichier .rar (.xlsm ne semble pas accepté) sur lequel j'ai reproduit,

- la version Jijie avec dico
- ta version avec dico
- ta version sans dico

les boutons sont dans cet ordre du haut vers le bas.

tu verras, par rapport aux deux premières version, il manque deux lignes (du moins chez moi)

cordialement.

Salut Patrick!

Bon je nage !?

Citation:

alors le but et de transposer dans l'autre sens
un plage de cellules de 20 lignes sur 3 colonnes par exemple
dans la boucle ca donnera

for i = 1 to 20'on boucle sur les ligne des cellules
redim preserve tablo(3, 1 to 20)
tablo(1,i)=lacellule ligne i colonne 1
tablo(2,i)=lacellule ligne i colonne 2
tablo(3,i)=lacellule ligne i colonne 3
next
pourtant tablo(1,i) veut dire tablo (ligne1,colonne i)

en fait on inverse les lignes et colonnes du sheets au tableau

tu voudrais que je place ça ou ?, je n'arrive pas à placer ça!!!??

Re salut Patrick,

Citation:

Salut Patrick!

Bon je nage !?

Mais si on nage on ne coule pas! :)

Donc voici pour le moment!

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
    'on ne peut redimentionner que le nombre de colonne dans un tableau a 2 dimentions
'on va donc tranférer les donées des cellules horizontalement dans le tablofinal
Option Base 1
Sub list_sans_doublons_par_tablo_sans_dico()
    Dim tablo As Variant 'variable pour les tableau de cellules
    Dim tablofinal() 'variable pour le tableau final qui contiendra  tout les element
    Dim presence As Boolean 'variable booleenne qui servira de tiket d'entrée pour les elements dans le tablo final
    feuille = Array(1, 2)
    For f = 1 To UBound(feuille) 'on boucle sur l'array contenant l'index ou le nom des des feuilles
        tablo = 0
        tablo = Sheets(f).Range("a1:e" & Sheets(f).Range("a" & Rows.Count).End(xlUp).Row)
        For i = 1 To UBound(tablo) 'on boucle sur tout les elements du tablo
 
            For E = 1 To n 'n etant le nombre d'item presents dans le tablofinal a chaque tour de boucle
               presence = False
               'si dans le tablofinal on trouve tablo (i,1)
               If tablofinal(1, E) = tablo(i, 3) Then
                    'on ajoute tablo(i,2) a tablofinal(2,e)
                    tablofinal(2, E) = tablofinal(2, E) + tablo(i, 2) 'addition code postal
                    tablofinal(3, E) = tablofinal(3, E) + tablo(i, 4) ' addition code INSEE
                    tablofinal(4, E) = tablofinal(2, E) / tablofinal(3, E)
                    tablofinal(5, E) = tablofinal(5, E) + 1
                    presence = True 'on met la booleenne a true
                    GoTo suite 'puisque l'on a trouver on sort de la boucle et on va au tablo(i,1) suivant
                End If
            Next E
            If presence = False Then
            'si la booleenne est resté a false ca veut dire que tablo(i,1) est absent de tablofinal(e,1)
             'on l'ajoute alors a tblofinal
                ReDim Preserve tablofinal(5, 1 To E) ' on preserve le nouvel element
                tablofinal(1, E) = tablo(i, 3): tablofinal(2, E) = tablo(i, 2) 'on l'inscrit dans le tablofinal
                tablofinal(1, E) = tablo(i, 3): tablofinal(3, E) = tablo(i, 4)
                If i <> 1 Then tablofinal(1, E) = tablo(i, 3): tablofinal(4, E) = tablofinal(2, E) / tablofinal(3, E)
                If i = 1 Then tablofinal(1, E) = tablo(i, 3): tablofinal(4, E) = "Coef"
                If i <> 1 Then tablofinal(1, E) = tablo(i, 3): tablofinal(5, E) = 1
                If i = 1 Then tablofinal(1, E) = tablo(i, 3): tablofinal(5, E) = "Nbre de ville"
 
                E = E + 1: n = n + 1 'on incremente les variables pour le decompte et le compte tablofinal
                'car n nous sert a boucler sur le tablofinal.count et e sert a placer le nouvel element
            End If
suite: 'on atterrit ici si il y a doublon ,on a donc sauter les lignes ou sinscrivent les données du nouvel element
        Next i
    Next f
    ThisWorkbook.Sheets("Feuil4").Range("a1:e300").ClearContents
    'on transpose le tablofinal horizontal dans un range vertical
    Sheets(4).Cells(1, 1).Resize(E - 2, UBound(tablofinal)) = Application.Transpose(tablofinal)
'traduction:
'Sheets(4).Cells(1, 1).Resize(le nombre de colonne du tablofinal,le nombre de lignes du tablofinal)=......
'comme tu peut le voir j'ai inverser les colonne du tablofinal avec les ligne de la plage de cellule de reception
 
 
End Sub

Mais ds l'exemple que je t'ais présenté, il inscrit en feuil4 ds les 5 colonnes sur les lignes 108,109,110,111 --> #N/A
et rien ds la ligne 107!

Sinon les totaux des codes postal et insee nb villes ....sont justes!

on peu dire que ça avance!

Maintenant je voudrais envoyer ça sur une listbox! C'est possible sans passer par la feuille?

re

j'ai remplacé :

Code:

Sheets(4).Cells(1, 1).Resize(E + 3, UBound(tablofinal)) = Application.Transpose(tablofinal)

par:

Code:

Sheets(4).Cells(1, 1).Resize(E - 2, UBound(tablofinal)) = Application.Transpose(tablofinal)

en gros ça ne prend que partiellement le tablo ---> -2 lignes

24/05/2013, 14h31
nibledispo

1 pièce(s) jointe(s)

essai sur tableau

bonjour Jijie

j'espère que tu pourras ouvrir la pièce au format zip.

et que l'on pourras m'expliquer pourquoi la version sans dico ne donne pas le résultat escompté.

cordialement
24/05/2013, 15h02
jijie

Bonjour nibledispo,

ça se joue ici

Code:

tablo = Sheets(F).Range("a1:b" & Sheets(F).Range("a" & Rows.Count).End(xlUp).Row)

C'est le problème du dimensionnement du tableau sur deux feuilles!(ou +)

ds le cas présent on le dimensionnement que sur la page 1, et comme il reste d'autre élément on les écrases ds tablo!
24/05/2013, 15h53
nibledispo

essai sur tableau

bonjour Jijie,

je ne vois pas très bien ce qui cloche.

je me suis avisé que mes feuilles 1 et 2 n'étaient pas des tableaux au sens strict.

je les ai donc transformé en tableau avec "insertion /tableau":

résultat:

la première version "dico" donne le bon résultat
la second version "dico" ne donne pas le bon résultat
la troisième version "tableau" donne à peu près n'importe quoi et se termine par un #N/A

cordialement.
24/05/2013, 18h54
patricktoulon

re

re

moi je dis lol!...

le tableau(tablo) represente la plage a tester
tablofinal represent la plage triée
les deux dernier exemples que j'ai donné fonctionne parfaitement bien

si il y a plus de colonne ou de ligne et quoi que, il faut adapter le test
if tablo(X,Y)=tablofinal(X,Z)forcement sinon soit tu te retrouve avec de N/a
ou manque de lignes

je redis lol....:oops::mouarf:

Re bonjour patrick et nibledispo

Donc voici après réflexion!

ds le fichier joint il est possible de tenir compte de la feuille1 ou 1 et 2

Ds tous les cas le calcul est bon!

par contre il faut bien mettre:

Code:

Sheets(3).Cells(1, 1).Resize(E, UBound(tablofinal)) = Application.Transpose(tablofinal)

si j'ajoute +3 on a --> #N/A sur les 3 dernières lignes

Par contre répondre a nibledispo je crois que si tu mets ça sa fonctionne:

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
'on ne peut redimentionner que le nombre de colonne dans un tableau a 2 dimentions
'on va donc tranférer les donées des cellules horizontalement dans le tablofinal
Option Base 1
Sub list_sans_doublons_par_tablo_sans_dico()
    Dim tablo As Variant 'variable pour les tableau de cellules
    Dim tablofinal() 'variable pour le tableau final qui contiendra  tout les element
    Dim presence As Boolean 'variable booleenne qui servira de tiket d'entrée pour les elements dans le tablo final
    feuille = Array(1, 2)
 
 
    For F = 1 To UBound(feuille) 'on boucle sur l'array contenant l'index ou le nom des des feuilles
        tablo = 0
        tablo = Sheets(F).Range("a1:b" & Sheets(F).Range("a" & Rows.Count).End(xlUp).Row)
        For i = 1 To UBound(tablo) 'on boucle sur tout les elements du tablo
 
            For E = 1 To n 'n etant le nombre d'item presents dans le tablofinal a chaque tour de boucle
               presence = False
               'si dans le tablofinal on trouve tablo (i,1)
               If tablofinal(1, E) = tablo(i, 1) Then
                    'on ajoute tablo(i,2) a tablofinal(2,e)
                    tablofinal(2, E) = tablofinal(2, E) + tablo(i, 2) 'addition code postal
 
 
                    presence = True 'on met la booleenne a true
                    GoTo suite 'puisque l'on a trouver on sort de la boucle et on va au tablo(i,1) suivant
                End If
            Next E
            If presence = False Then
            'si la booleenne est resté a false ca veut dire que tablo(i,1) est absent de tablofinal(e,1)
             'on l'ajoute alors a tblofinal
                ReDim Preserve tablofinal(2, 1 To E) ' on preserve le nouvel element
                tablofinal(1, E) = tablo(i, 1): tablofinal(2, E) = tablo(i, 2) 'on l'inscrit dans le tablofinal
 
 
 
                E = E + 1: n = n + 1 'on incremente les variables pour le decompte et le compte tablofinal
                'car n nous sert a boucler sur le tablofinal.count et e sert a placer le nouvel element
            End If
suite: 'on atterrit ici si il y a doublon ,on a donc sauter les lignes ou sinscrivent les données du nouvel element
        Next i
    Next F
    ThisWorkbook.Sheets("Feuil3").Range("a1:e300").ClearContents
    'on transpose le tablofinal horizontal dans un range vertical
    Sheets(3).Cells(1, 1).Resize(E, UBound(tablofinal)) = Application.Transpose(tablofinal)
'traduction:
'Sheets(4).Cells(1, 1).Resize(le nombre de colonne du tablofinal,le nombre de lignes du tablofinal)=......
'comme tu peut le voir j'ai inverser les colonne du tablofinal avec les ligne de la plage de cellule de reception
 
 
End Sub

Chez moi ça marche ! Confirme moi le STP!

et patrick tu as une piste pour la listbox?

Cordialement,

24/05/2013, 19h04
patricktoulon

Citation:

Envoyé par ji jie

Bonjour nibledispo,

ça se joue ici

Code:

tablo = Sheets(F).Range("a1:b" & Sheets(F).Range("a" & Rows.Count).End(xlUp).Row)

C'est le problème du dimensionne ment du tableau sur deux feuilles!(ou +)

ds le cas présent on le dimensionnement que sur la page 1, et comme il reste d'autre élément on les écrases dans tablo!

oui ils sont écrasé car "F" dans la boucle change
c'est tout le tableau(tableau) qui change en fonction de "F"Mais quand ca change ce qui il y avait avant dans le tableau sont désormais dans le tableau final et trié

c'est le propre de ma fonction
1 boucle sur nombre de feuille
2tablo devient feuille 1 et puis 2 et puis X
a chaques changement tableau se place dans table final par le test presence
3 resize la premiere cellule de reception le nombre de "N"lignes et X colonne

de toute facon en travaillant hiers soir je me suis rendu compte que les livres n'expliquaient pas tout il semblerait que l'on puisse redimensionner un tableau multidimension ligne et colonnes
j'avoue que je suis encore dubitatif
je me suis rendu compte aussi que l'on pouvait faire encore plus simple
avec un seul tableau pour analyser
je vous fait une petite demo et je vous la livre

a plus

re
Maintenant attention c'est a but exercice (juste pour le fun )
il est certaint que pour finaliser une app je choisirais le scripting dictionnary

les dicos sont bien plus rapide
24/05/2013, 19h21
jijie

Citation:

Maintenant attention c'est a but exercice (juste pour le fun )
il est certaint que pour finaliser une app je choisirais le scripting dictionnary

les dicos sont bien plus rapide

Oui mais là je ne comprends pas puisque si on a plusieurs colonnes?

bonsoir en esperant ne pas aller trop vide :aie:;)

voila comme promis une 3 eme version utilisant 2 boucles imbriquées
sur un meme tableau
trop rigolo ce machin

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
34
35
36
37
38
39
40
41
42
43
 
Option Base 1
Sub list_sans_doublons_par_tablo_sans_dicoV2()
  Dim tablo As Variant    'variable pour les tableau de cellules
    Dim tablofinal()    'variable pour le tableau final qui contiendra  tout les element
    Dim FEUILLE As Variant
    Dim t As Long
        FEUILLE = Array(1, 2)
    '***********************************************************************************
    'PARTIE 1
    'CETTE PARTIE DU CODE  A REMPLIR LE TABLOFINAL SANS TRIER LES DOUBLONS AVEC TOUTE LES DONN2ES DE TOUTE LES FEUILLE CONCERNEES
    For F = LBound(FEUILLE) To UBound(FEUILLE)    'on boucle sur l'array contenant l'index ou le nom des des feuilles
        tablo = Sheets(FEUILLE(F)).Range("a1:b" & Sheets(FEUILLE(F)).Range("a" & Rows.Count).End(xlUp).Row)
        For a = LBound(tablo) To UBound(tablo)    'on boucle sur tout les elements du tablo
            t = t + 1
            ReDim Preserve tablofinal(2, 1 To t)    ' on preserve le nouvel element
            tablofinal(1, t) = tablo(a, 1): tablofinal(2, t) = tablo(a, 2)
        Next a
    Next F
    'FIN DE PARTIE 1
    '************************************************************************************************
    'partie 2
    'CETTE PARTIE SERT A TRIER LES DOUBLONS EN 2 BOUCLES SUR LUI MEME
    ' principe et de boucler A PARTIR DE  l'item suivant l'index de la premiere boucle
    'si il est identique prendre les points de la colonne 2 de lindex 2emeboucle et les ajouter a lindex 1ere boucle
    'ensuite vider colonne 1 et 2 de lindex 2 eme boucle
 
    For i = 1 To t
        For E = i + 1 To t
            If tablofinal(1, E) = tablofinal(1, i) Then
                tablofinal(2, i) = tablofinal(2, i) + tablofinal(2, E)
                tablofinal(2, E) = "": tablofinal(1, E) = ""
            End If
        Next
    Next
    'a partir de la on se retrouve avec un tablofinal trié mais avec des lignes vides
    'ici on le transpose dans le sheets4
    Sheets(4).Cells(1, 1).Resize(t, 2) = Application.Transpose(tablofinal)
    ' il ne nous reste plus qu'a supprimer les lignes vides dans le usedrange et le tour est joué
    Sheets(4).UsedRange.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
' fin de partie 2
'*************************************************************************************************
End Sub

regalez vous jijie et nible dispo
pour jijie
AH!! au fait meme avec un dico tu peut travailler sur plus de 2 colonnes
tu n'a toujours pas trouvé l'actuce??,:mouarf::mouarf::aie::mouarf:
tu la veux?:mrgreen::mouarf::mrgreen::aie:;)

Ah au fait pour ta listbox c'est userformX.listbox1.list=tablofinal
hihihihi!!!!!:mouarf::mouarf:
et re lol

25/05/2013, 10h33
jijie

Salut Patrick,

Et il se marre !!!!!!

Bon effectivement il vrai que tu est capable de tourner ça ds tout les sens!

Ta dernière version le montre bien! Mais si on regarde bien, la rapidité n'est pas là! Par contre c'est sympa de voir comment il est possible de multiplier les solutions !

Pour la listbox j'avais trouvé!!!:mouarf:

Code:

Sheets("feuil3").ListBox1.List = Application.Transpose(tablofinal)

Par contre pour le Dico je cherche encore!!!!!:oops:
Mais le fichier que je t'ais laissé montre bien que ta version sans dico sur le post du 22/05 à 12h42 est tout de même très très rapide!:ccool:

En tout cas FELICITATION, et je dois m'incliner, et je ne regrette en rien d'avoir lancer ce post, car ça m'a fait bien avancé!

Je ferme le post quand j'aurais trouvé la solution avec le dico!

Merci

Bonjour jijie

je suis tout a fait daccord avec toi la rapidité n'est pas la

meme avec l'exemple avec sans dico
la methode avec dico restera la plus rapide tu aura beau tourner ca dans tout les sens tu n'obtiendra jamais la rapidité de la methode avec dico

la raison est toute simple

c'est que le test if not exists mondico(x,y)renplace une sous boucle sur tout un tableau

exemple pour faire la meme chose que "

Code:

if not exit (tablo(x,y

)
il faut faire avec les tableaux
Code:

1 2 3 4 5 for i ) 1 to ubound (tablo) for e = i+1 to ubound (tablo) next next
en fait pour faire la meme verification il faut faire l'operation 1* puissance le nombre d'item du tableau pour un seul item et * puissance nombre d'item pour la totalité du tableau

donc en gros avec le dico 1 fois
sans dico nombre d'item * puissance n'ombre d'item

tu comprend bien que il n'y a pas d'hésitation quand au choix de la methode

cela dit avec les dico on est limitéen terme de parametres
et quoi que
avec un tableau et surtpout multi dimention on fait ce que l'on veut puisque c'et dans les parametres que tout ce joue

bon comme tu a été jentille
astuce avec dico sur X colonnes

au moment du test regroupe les valeurs de toute les cellules sur la meme lignesdans une variable et fait le test sur la variable obtenue hihihi!! c'est tout simple
et retranscrit apres test dans un tableau chaque cellule séparée
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 tablo=taplage for a 1 to ubound tablo1 for i = 1 to taplage .columns.count lemot = lemot & cells(i,a) next if not exist mondico(lemot ) mondico(lemot)=''" tablo2(x,1)=cells(x,1) tablo2(x,2)=cells(x,2) tablo2(x,3)=cells(x,3) etc......... end if next
allez encore un peu de méditation

mais je le repete une derniere fois la methode avec les dicos sont plus rentables en terme de temps utile

bref on s'est bien amusé

alors on clique resolu ou pas ????
ou on va encore plus loin (aspirine requis)

25/05/2013, 16h18
jijie

Patrick,

Décidément, je n'y arrive pas :cry:

Je crois comprendre que tu voudrais me faire faire un tablo sur l' item mais je ne sais pas comment le tourner en:
1 si mondico exist
2 si il n'existe pas!

alors je ne clique pas sur résolu!

Bonjour jijie

alors je voulais le garder pour moi jusqu'a que je finnise un petit tutoriel sur la questions des doublons avec les dicos et tableaux

mais en voila un exemple qui tri les doublons en prenant en compte la colonne "a" et "b" on peu aller plus loin bien entendu il suffit pour cela de modifier l'indice dans la boucle

alors voila une liste de nom prenom avec mails

Citation:

toto henry toto@fhfh
serge truc serge@jhfhfh
toto machin toto2@hfhfh
serge chose serge2@kfjf
toto henry toto@fhfh
riri bidule riri@dhdfh
dédé toto dede@cjfjfj

nous allons supprimer les doublons qui ont le meme prenom et meme noms

code
apel a la fonction
Code:

1 2 3 Sub test() tri_doublon_multicolonne Range("a1:c" & Range("a" & Rows.Count).End(xlUp).Row) End Sub
et voila la foncion
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 Public Function tri_doublon_multicolonne(plage As Range) Dim dico, tablo, tablosd(), e, textrec As String Set dico = CreateObject("Scripting.Dictionary") tablo = plage.Value plage.Clear For i = 1 To UBound(tablo) 'boucle sur toute les ligne du tableau(tablo) textrec = "" For a = 1 To plage.Columns.Count - 1 textrec = textrec & tablo(i, a) Next If Not dico.Exists(textrec) Then dico(textrec) = i Next i = dico.items For n = 0 To dico.Count - 1 e = e + 1 ReDim Preserve tablosd(1 To dico.Count, 3) tablosd(e, 1) = tablo(i(n), 1) tablosd(e, 2) = tablo(i(n), 2) tablosd(e, 3) = tablo(i(n), 3) Next Cells(plage.Row, plage.Column).Resize(UBound(tablosd), 3) = tablosd End Function
si tu trouve qu'il y avait trop de toto le probleme est resolu :mouarf:
re lol.....:mouarf::roll::aie:

sinon nurofen c'est bien aussi pour le mal de tete ca cible la douleur

voila la fonction native "removeduplicate" d'excel qui fait la meme chose
Code:

1 2 3 4 Sub truc2() ActiveSheet.Range("a1:b" & Range("b" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo End Sub
bonne etude

Voir 40 message(s) de cette discussion en une page