Résultat avec un critère dans un array, est-ce possible ?

Version imprimable

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

Bonjour a vous,

J'ai un code qui est utilisé, il fonctionne a merveille mais il est trop lent, vraiment beaucoup. Comme ils s'agit d'information transposé dans un autre endroit j'ai essayé de copie des row ou des range. J'ai fait quelque tentative infructueuse et en fouillant que je devrais utilisé les array. J'ai vu un video sur le web de wiseowl tutoriel et aussi lu celui de silkyroad. Étant donné que je suis vraiment novice en terme de concept de Array, je vous solicite pour votre aide. Tous les exemple que j'ai vu ne correspondent pas vraiment a ma situation et je ne comprends pas toute a fais a 100% le concept et l'utilisation de celui-ci. Je me retrouve donc avec une piste de solution sans la comprendre. Pour la dimension je ne sais pas si c'Est une seul et unique ou 2. Comme vous voyez je part de loins

TOus les exemple que j'ai vu prenait un tableau effectuais des tri et le copiais entièrement dans une nouvelle emplacement. Je n'ai malheureusement pas vu de cas auquel on appliquais un critère pour le resultats. Donc est ce possible ou avez vous une idée autre afin d'amélioré le code

Citation:

'on copie les données dans la feuille correspondantes

qui est le boulet de ma sub ???

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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
Sub genere_onglets_etablissement()
 
'    On Error GoTo errorhandler:
 
    Dim x As Integer
    Dim LettreVoulue As String
    LettreVoulue = TrouveLettreColonne([acronyme_etab])
    Dim nom_etablissement As Variant
    Dim entete As Range
    Dim start As Single
    Dim finish As Single
 
    start = Timer
 
    Application.ScreenUpdating = False
 
'nettoie le nom des etablissements provenant du LAC afin d'éviter d'avoir 2 onglets
 
    Range(LettreVoulue & 2, LettreVoulue & LastLignUsedInSheet("R_MoulinetteAValider")).Select
    nettoyerseul
 
'détruire onglet si ré-exécution de la macro
 
    detruire_onglet_etablissement
 
'création des feuilles selon le nom des etablissement
 
    For Each nom_etablissement In Sheets("R_MoulinetteAValider").Range(LettreVoulue & 2, LettreVoulue & LastLignUsedInColumn(LettreVoulue))
 
    x = x + 1
 
        If Cells(x + 1, [valider_etablissement].Column) = "x" Or Cells(x + 1, [valider_etablissement].Column) = "X" Then
 
                If sheetExists(nom_etablissement.value) = True Then
 
                Else
 
                    Sheets.Add.Name = nom_etablissement
                    Sheets("R_MoulinetteAValider").[ID_titre].Copy Sheets(nom_etablissement.value).Range("a1")
                    Sheets("R_MoulinetteAValider").[seq_titre].Copy Sheets(nom_etablissement.value).Range("b1")
                    Sheets("R_MoulinetteAValider").[pair_impair_titre].Copy Sheets(nom_etablissement.value).Range("c1")
                    Sheets("R_MoulinetteAValider").[etab_titre].Copy Sheets(nom_etablissement.value).Range("d1")
                    Sheets("R_MoulinetteAValider").[acronyme_etab_titre].Copy Sheets(nom_etablissement.value).Range("e1")
                    Sheets("R_MoulinetteAValider").[item_etab_moulinette_titre].Copy Sheets(nom_etablissement.value).Range("f1")
                    Sheets("R_MoulinetteAValider").[item_etab_titre].Copy Sheets(nom_etablissement.value).Range("g1")
                    Sheets("R_MoulinetteAValider").[descr_etab_titre].Copy Sheets(nom_etablissement.value).Range("h1")
                    Sheets("R_MoulinetteAValider").[couleur_etab_titre].Copy Sheets(nom_etablissement.value).Range("i1")
                    Sheets("R_MoulinetteAValider").[four_etab_titre].Copy Sheets(nom_etablissement.value).Range("j1")
                    Sheets("R_MoulinetteAValider").[fournisseur_titre].Copy Sheets(nom_etablissement.value).Range("k1")
                    Sheets("R_MoulinetteAValider").[marque_etab_titre].Copy Sheets(nom_etablissement.value).Range("l1")
                    Sheets("R_MoulinetteAValider").[cat_etab_titre].Copy Sheets(nom_etablissement.value).Range("m1")
                    Sheets("R_MoulinetteAValider").[format_contrat_titre].Copy Sheets(nom_etablissement.value).Range("n1")
                    Sheets("R_MoulinetteAValider").[qte_an_titre].Copy Sheets(nom_etablissement.value).Range("o1")
                    Sheets("R_MoulinetteAValider").[prix_contrat_titre].Copy Sheets(nom_etablissement.value).Range("p1")
                    Sheets("R_MoulinetteAValider").[valider_etablissement_titre].Copy Sheets(nom_etablissement.value).Range("q1")
                    Sheets("R_MoulinetteAValider").[commentaire_etablissement_titre].Copy Sheets(nom_etablissement.value).Range("r1")
                    Sheets("R_MoulinetteAValider").[commentaire_etablissement_titre].Copy Sheets(nom_etablissement.value).Range("s1")
 
                     Range("s1").value = "Reponse de l'etablissement"
                     Columns("a:C").ColumnWidth = 6.11
                     Columns("D").ColumnWidth = 8.33
                     Columns("E").ColumnWidth = 15.78
                     Columns("F").ColumnWidth = 11.89
                     Columns("G").ColumnWidth = 15.78
                     Columns("H").ColumnWidth = 40
                     Columns("I:P").ColumnWidth = 15.78
                     Columns("Q").ColumnWidth = 11.89
                     Columns("R:U").ColumnWidth = 40
 
                     Range("a2").Activate
 
                End If
 
 'on copie les données dans la feuille correspondantes
 
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [ID].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 1)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [seq].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 2)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [pair_impair].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 3)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [etab].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 4)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [acronyme_etab].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 5)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [item_etab_moulinette].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 6)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [item_etab].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 7)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [descr_etab].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 8)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [couleur_etab].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 9)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [fourn_etab].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 10)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [Fournisseur].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 11)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [marque_etab].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 12)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [cat_etab].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 13)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [format_contrat].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 14)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [qte_an].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 15)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [prix_contrat].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 16)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [valider_etablissement].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 17)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [commentaire_etablissement].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 18)
 
'on supprime les lignes vides si bien sur les feuilles ont été créés
 
                    Sheets(nom_etablissement.value).Select
                    Range("A2").EntireRow.Insert
                    Sheets(nom_etablissement.value).Range("b1:B" & LastLignUsedInColumn("B")).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
                    With ActiveSheet.Tab
                        .ThemeColor = xlThemeColorAccent3
                        .TintAndShade = 0.399975585192419
                    End With
        End If
 
    Sheets("R_MoulinetteAValider").Select
 
    Next nom_etablissement
 
finish = Timer
 
MsgBox "durée du traitement: " & finish - start & " secondes"
 
Exit Sub
 
errorhandler:
MsgBox "Erreur d'exécution, la procédure va se terminer !", vbCritical
 
End Sub

merci encore pour votre aide, commentaires, références a d'autre ouvrage et surtout votre temps !!!

amicalement JP

30/08/2018, 09h20
a_diard

Bonjour

En passant par une variable tableau.

bonjour
sans ton classeur avec le peu de precisions que tu donnes sur la structure de ton classeur(de tes données) on va pas aller bien loin

cependant si tes cellules de base sont contigues tu peux remplacer tes lignes :
Code:

1 2 3 4 5 6 Sheets("R_MoulinetteAValider").[ID_titre].Copy Sheets(nom_etablissement.Value).Range("a1") Sheets("R_MoulinetteAValider").[seq_titre].Copy Sheets(nom_etablissement.Value).Range("b1") Sheets("R_MoulinetteAValider").[pair_impair_titre].Copy Sheets(nom_etablissement.Value).Range("c1") 'etc... 'etc.... 'etc....
par ceci :

Si c'est une ligne

Code:

Sheets(nom_etablissement.Value).Range("a1").Resize(1, 19) .value= Sheets("R_MoulinetteAValider").[ID_titre].Resize(1, 19).value

Si c'est une colonne(donc transposition)

Code:

Sheets(nom_etablissement.Value).Range("a1").Resize(1, 19).value = Sheets("R_MoulinetteAValider").[ID_titre].Resize(19, 1).value

a noter que je n'utilise meme pas copy ;)
et combien meme le Sheets(nom_etablissement.Value) ne serait pas activé ca fonctionnerait quand meme
on fait donc sauter en un coup tout les activates générés par copy destination

si tes cellule de base ne sont pas contigues tu pourrais créer un array et l'injecter dans le resize de destination
la encore pas de activate ;)

30/08/2018, 16h51
jpvba

Merci beaucoup pour vos conseilles et réponses !!!!

Intéressant ce que vous dites monsieur Toulon a propos du transfert de donné sans copy, c'Est sur que je vais utilisé le tout dans le future !!! :D

J'aurais mis habituellement des imprimes écrans mais le tableau est tellement large que si je le rapetisse, le tout deviens illisible. Donc le texte sera le medium d'explication

Afin d’être un peu plus explicite sur la structure du fichier voici de l'information sur ma feuille source, elle a des donnés de la colonnes "A" à "AT". Au niveau des rangées, c'Est variable selon le fichier dont la feuille porte toujours le même nom sois R_MoulinetteAValider. Donc je veux copier le contenue des cellules "A" à "P" et "AC" et "AD" dans les feuilles correspondant à la valeur de "K" (qui est la le nom du fournisseur), lors que la valeur X ou x est dans la colonne "AC". En bon français retourne l'information de l'établissement voulus dans la feuille correspondant a son nom si j'ai cocher un X dans une colonne et ce pour toute les lignes.

Où que je frappe un mur avec une variable tableau c'est que tous les documents de formations (vidéo, texte), c'est que l'On copie 100% des données sources dans une destinations sans en enlever. Donc je ne sais pas si je dois faire un tableau avec tous les données et trouvé une solution afin de pouvoir chercher seulement celles désirée selon les critères voulues. L'autre possibilité serais de seulement de mettre les valeuirs voulus du fichier source (je frappe un mur dans cette situation lorsque je tente de populé la dimension connu avec inconnu, je n'ai pas vu d'exemple) ou l'autre que je vois possiblement moins efficace 2 tableaux sois pour les 2 groupes de données contigue mais cette dernière semble moins efficace (faire 2 array quand on peut en faire 1).

En resumé, tous les outils de formation que j'ai vu ne précise pas si les données de l'array (tableau) source dois seulement contenir les données voulues ou si elle peut en contenir plus et si c'Est le cas, comment seulement chercher ceux voulues. Mon cas nécessite une recherche ou boucle ou tri, bref là également je suis sur que vous pouvez m'éclairé.

merci pour votre temps et je vous l'assure c'est vraiment apprécié et j'en suis recommencé !!!

J'ai réussi a "populé" (je ne connais malheureusement le bon terme en français) le tableau avec les données seulement voulu

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
 
    Dim tableau() As Variant
 
 
 
 
    tableau = Union(Range(TrouveLettreColonne([ID_titre]) & 2, TrouveLettreColonne([ID_titre]) & LastLignUsedInSheet("R_MoulinetteAValider")), _
         Range(TrouveLettreColonne([seq_titre]) & 2, TrouveLettreColonne([seq_titre]) & LastLignUsedInSheet("R_MoulinetteAValider")), _
         Range(TrouveLettreColonne([pair_impair_titre]) & 2, TrouveLettreColonne([pair_impair_titre]) & LastLignUsedInSheet("R_MoulinetteAValider")), _
         Range(TrouveLettreColonne([etab_titre]) & 2, TrouveLettreColonne([etab_titre]) & LastLignUsedInSheet("R_MoulinetteAValider")), _
         Range(TrouveLettreColonne([acronyme_etab_titre]) & 2, TrouveLettreColonne([acronyme_etab_titre]) & LastLignUsedInSheet("R_MoulinetteAValider")), _
         Range(TrouveLettreColonne([item_etab_moulinette_titre]) & 2, TrouveLettreColonne([item_etab_moulinette_titre]) & LastLignUsedInSheet("R_MoulinetteAValider")), _
         Range(TrouveLettreColonne([item_etab_titre]) & 2, TrouveLettreColonne([item_etab_titre]) & LastLignUsedInSheet("R_MoulinetteAValider")), _
         Range(TrouveLettreColonne([descr_etab_titre]) & 2, TrouveLettreColonne([descr_etab_titre]) & LastLignUsedInSheet("R_MoulinetteAValider")), _
         Range(TrouveLettreColonne([couleur_etab_titre]) & 2, TrouveLettreColonne([couleur_etab_titre]) & LastLignUsedInSheet("R_MoulinetteAValider")), _
         Range(TrouveLettreColonne([four_etab_titre]) & 2, TrouveLettreColonne([four_etab_titre]) & LastLignUsedInSheet("R_MoulinetteAValider")), _
         Range(TrouveLettreColonne([fournisseur_titre]) & 2, TrouveLettreColonne([fournisseur_titre]) & LastLignUsedInSheet("R_MoulinetteAValider")), _
         Range(TrouveLettreColonne([marque_etab_titre]) & 2, TrouveLettreColonne([marque_etab_titre]) & LastLignUsedInSheet("R_MoulinetteAValider")), _
         Range(TrouveLettreColonne([cat_etab_titre]) & 2, TrouveLettreColonne([cat_etab_titre]) & LastLignUsedInSheet("R_MoulinetteAValider")), _
         Range(TrouveLettreColonne([format_contrat_titre]) & 2, TrouveLettreColonne([format_contrat_titre]) & LastLignUsedInSheet("R_MoulinetteAValider")), _
         Range(TrouveLettreColonne([qte_an_titre]) & 2, TrouveLettreColonne([qte_an_titre]) & LastLignUsedInSheet("R_MoulinetteAValider")), _
         Range(TrouveLettreColonne([prix_contrat_titre]) & 2, TrouveLettreColonne([prix_contrat_titre]) & LastLignUsedInSheet("R_MoulinetteAValider")), _
         Range(TrouveLettreColonne([valider_etablissement_titre]) & 2, TrouveLettreColonne([valider_etablissement_titre]) & LastLignUsedInSheet("R_MoulinetteAValider")), _
         Range(TrouveLettreColonne([commentaire_etablissement_titre]) & 2, TrouveLettreColonne([commentaire_etablissement_titre]) & LastLignUsedInSheet("R_MoulinetteAValider")))

Il me reste seulement a trouvé une façon de cherché sur l'array la cellule contenant le fameux X ... je continue encore et encore de chercher sur le web.

30/08/2018, 22h36
patricktoulon

re

re
est que toutes ces cellules sont contigues ou pas ??
30/08/2018, 22h36
jpvba

non
30/08/2018, 22h54
patricktoulon

re

je pense pas que tu ai compris la definition de tableau
avec union tu obtiens un range pas un tableau

si je m'en refere a ton code je crois comprendre que tu recupere les cellules d'une ligne(la 2) sur x colonnes pas forcement contigues je parle bien des colonnes qui ne sont pas contigues

c'est bien ca?
30/08/2018, 23h21
jpvba

oui effectivement je fais un union voulant faire un tableau dynamique. Bref si je me fis a ce que j'ai vu

Il se peut que je n'utilise pas comme il le faut le tableau, disons que cette notion est très nouvelle pour moi.

Je récupère effectivement les colonnes en bas de l'entete. Étant donné que j'y vais avec des emplacement relatifs, au cas où que quelqu'un ajoute une colonne dans le fichier., j'ai nommé les colonne a l'aide du gestionnaire de nom.

Donc je prends les colonnes que j'ai nommés dans mon commentaire ([ID_titre] et suivant) afin de pouvoir peuplé le tableau de la premiere donné sans titre à la dernier donné de la colonne. La dernière données de la colonnes est variable selon le fichier qui est utilisé.

Mon but est de généré un onglet portant le nom d'un établissement, le populé si il y a un X dans une colonne spécifique d'infomation de cellules non contigue. LA premiere étape c'Est que je détruit les onglets existants au cas ou quelqu'un regénère la sub.

Ce que j'ai présentement est correct mais est super lents lorsqu'il y a beaucoup de ligne ayant un X dans une colonne

Je ne sais pas si cela répond a vos interrogation si non, je vais essayé d'Expliqué le tout autrement

en vous remerciant pour votre coup de pouce !!!

amicalement JP
04/09/2018, 15h17
jpvba

En fouillant sur le web, j'ai trouvé que les tableaux ne pouvais pas contenir de valeur contigu.

Ce que j'ai trouvé comme solution est de mettre les valeurs voulues dans une feuille temporaire. Il y a t-il un autre solution plus efficaces ???

Également, pour pouvoir avoir seulement avoir les valeurs dont une des colonnes contiennes un X, avez-vous des conseils ??? merci !!!!
04/09/2018, 15h37
patricktoulon

re

re

Citation:

En fouillant sur le web, j'ai trouvé que les tableaux ne pouvais pas contenir de valeur contigu.

???????????:koi:

il est vrai que dans le jargon famillier on appelle souvent un range un tableau mais ne pas confondre avec une variable tableau
une variable tableau est forcement contigues :ptdr: si on peut s'exprimer ainsi
par contre une variable tableau contenant des variables tableau peut tres bien contenir des tableaux issus de plage non contigues :ptdr: de meme que des plage(range) d'ailleurs:ptdr:

il y a aussi le fait q'un range a 2 dimentions (ligne/colonne) une variable tableau quand a elle peut en avoir 36 milles

alors oui je ris beaucoup car c'est vrai que si on ne connait pas les bases c'est a dire les variable on s'y perds vites

j'avoue que comme tu n'utilise probablement pas le bon object(variable) je pige pas ce que tu veux faire en fait
04/09/2018, 15h45
jpvba

Bonjour Monsieur Toulon, merci pour votre réponses.

SI je repart du tout début, du tout commencement, je veux optimiser une sub auquel je copie une a une des cellules selon certaines conditions. Cette sub marche bien mais elle est plus lent qu'un escargot lorsqu'il y a beaucoup de donné.

Je cherche des pistes de solutions afin de pouvoir optimiser, maximiser celle-ci. J'ai trouvé les variables tableau mais effectivement je crois que je me perd en vous perdant :ptdr: .

Donc je suis en train d'essayé de faire une variable tableau afin de pouvoir donné de la vitesse a ma sub. Comme vous le constater, c'Est quelque chose qui est tout a fait nouveau et que j'utilise possible de façon erroné.

Avez-vous des pistes de solutions afin de rendre plus rapide la sub du début ??? (voir mon premier message)

mille fois merci !!!

d'accord je vais essayer d'eguyer a ma facon
pour commencer je reprends ton exemple du debut qui ressemble a ceci
Code:

1 2 3 4 5 6 7 Sub truc_de_jpvba() Sheets("R_MoulinetteAValider").[ID_titre].Copy Sheets(nom_etablissement.Value).Range("a1") Sheets("R_MoulinetteAValider").[seq_titre].Copy Sheets(nom_etablissement.Value).Range("b1") Sheets("R_MoulinetteAValider").[pair_impair_titre].Copy Sheets(nom_etablissement.Value).Range("c1") Sheets("R_MoulinetteAValider").[etab_titre].Copy Sheets(nom_etablissement.Value).Range("d1") 'etc... 'etc....
quégalère ton bidule t'en a beaucoup comme ca :mouarf:
je constate que quoi??
et bien ma premiere constatation c'est que tu transpose tes cellules dans un range verticale contigues (une cellule en dessous de l' autre )en l'occurence "A1:S1"

ce qui serait bien n'est ce pas se serait de pouvoir faire

Code:

Sheets(nom_etablissement.Value).Range("a1:s1")=tout mon paquet de cellules

a ben oui alors ca serait bien
oui mais comment faire un tableau de valeur avec des valeurs de cellules non contigues a ben flute alors ;)

regardons de plus pret ce morceau de code

Code:

Sheets("R_MoulinetteAValider").[ID_titre].Copy Sheets(nom_etablissement.Value).Range("a1")

aben tiens voila quelque chose d'interessant c'est un nom qui figure dans le gestionnaire de nom et donc fait reference a une cellule dans le sheet("R_MoulinetteAValider")

on pourrait donc ecrire

Code:

[ID_titre].Copy Sheets(nom_etablissement.Value).Range("a1")

a ben deja c'est plus clair n'est ce pas
ca veut dire quoi?
ben tout simplement que le nom entre crochet designe la cellule pas besoins du nom de son parent ou (quoiqu'est ce)

mais on est toujours avec un principe de copie cell par cell pfiuuufff qué galère plein le teston
et si non de pipe en bois on mettait tout ca dans un array ( un array est une variable tableau a 1 dimention)
a ben en voila une bonne idée ;)
essayons voir
Code:

1 2 3 4 5 6 7 8 9 Sub test() Dim montableau As variant montableau = Array([ID_titre], [seq_titre], [pair_impair_titre], [etab_titre], [acronyme_etab_titre], [item_etab_moulinette_titre], [item_etab_titre] _ , [descr_etab_titre], [couleur_etab_titre], [four_etab_titre], [four_etab_titre], [fournisseur_titre], [marque_etab_titre], [cat_etab_titre] _ , [format_contrat_titre], [qte_an_titre], [prix_contrat_titre], [valider_etablissement_titre], [commentaire_etablissement_titre], [commentaire_etablissement_titre]) Debug.Print Join(montableau, ";") Sheets(nom_etablissement.Value).Range("a1:s1") = Application.Transpose(montableau) End Sub
a noter que pour que se soit kif kif les dimention on aurait pu faire

Code:

Sheets(nom_etablissement.Value).Range("a1").resize(ubound(montableau)+1,1) = Application.Transpose(montableau)

.....

la lumiere!!!..... qui a eteind la lumiere.... allo !!!..... y a quelqu'un :piou:......j'ai peur dans le noir

voila comment on se retrouve avec une plage non contigues dans un array contigues ;)
et c'est une facon parmis tant d'autres

04/09/2018, 16h34
jpvba

Un gros merci monsieur Toulon, je vais analyser attentivement votre réponse et continuer mes expérimentations !!!

;)
04/09/2018, 16h50
jpvba

J'ai effectué l'essaie du code avec la partie de la copie de cellule une a une

exemple

Code:

Sheets("R_MoulinetteAValider").Cells(x + 1, [ID].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 1)

J'arrive avec un erreur lors du

Code:

Debug.Print Join(tableau, ";")

Si je regarde les variables locales, tableau(9) erreur 2029 Variant/Error

merci pour votre aide !!!!
06/09/2018, 22h51
jpvba

Bonjour a vous,

LE code tel quel ne crée pas le résultat voulu. Dans la première feuille correspond a la première établissement ayant un x les titres sont dans la première colonne. De la ligne 2 à 14 nous avons les titres mails il manque les 5 premiers. Dans la seconde feuille, de la ligne 2 à 12, il y a une partie des titres. Dans la 3ieme et dernière de mon exemple, de la ligne 2 à 11, il y manque beaucoup de titre.

Je ne vois toujours pas la lumière au bout du tunnel. Suis-je encore loin de la sortie ??? :roll:
18/09/2018, 16h42
jpvba

Est-ce que vous aurriez d'autre piste de solution ??? Je suis stagnant au meme status depuis une semaine ...

Si je combine les tableaux en 1 tableau, il me reste a dire que je veux copier une ligne et non cellule par cellule.

J'arrive a ceci

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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
Sub genere_onglets_etablissement_test_multitableau_5()
    
'    On Error GoTo errorhandler:
    Dim x As Integer
    Dim LettreVoulue As String
    LettreVoulue = TrouveLettreColonne([acronyme_etab])
    Dim nom_etablissement As Variant
    Dim start As Single
    Dim finish As Single
       
    Dim tableau1() As Variant
    Dim tableau2() As Variant
    Dim tableau3() As Variant
    Dim tableau4() As Variant
    Dim tableau5() As Variant
    Dim tableau6() As Variant
    Dim tableau7() As Variant
    Dim tableau8() As Variant
    Dim tableau9() As Variant
    Dim tableau10() As Variant
    Dim tableau11() As Variant
    Dim tableau12() As Variant
    Dim tableau13() As Variant
    Dim tableau14() As Variant
    Dim tableau15() As Variant
    Dim tableau16() As Variant
    Dim tableau17() As Variant
    Dim tableau18() As Variant
    
    Dim tableaux As Variant
    

    Dim ligne As Variant
    Dim i As Long
    

start = Timer

    Application.ScreenUpdating = False
    
    
'mettre les cellules voulues dans le tableau
        Sheets("R_MoulinetteAValider").Activate
    
       tableau1() = Range(TrouveLettreColonne([ID_titre]) & 2, TrouveLettreColonne([ID_titre]) & LastLignUsedInSheet("R_MoulinetteAValider"))
       tableau2() = Range(TrouveLettreColonne([seq_titre]) & 2, TrouveLettreColonne([seq_titre]) & LastLignUsedInSheet("R_MoulinetteAValider"))
       tableau3() = Range(TrouveLettreColonne([pair_impair_titre]) & 2, TrouveLettreColonne([pair_impair_titre]) & LastLignUsedInSheet("R_MoulinetteAValider"))
       tableau4() = Range(TrouveLettreColonne([etab_titre]) & 2, TrouveLettreColonne([etab_titre]) & LastLignUsedInSheet("R_MoulinetteAValider"))
       tableau5() = Range(TrouveLettreColonne([acronyme_etab_titre]) & 2, TrouveLettreColonne([acronyme_etab_titre]) & LastLignUsedInSheet("R_MoulinetteAValider"))
       tableau6() = Range(TrouveLettreColonne([item_etab_moulinette_titre]) & 2, TrouveLettreColonne([item_etab_moulinette_titre]) & LastLignUsedInSheet("R_MoulinetteAValider"))
       tableau7() = Range(TrouveLettreColonne([item_etab_titre]) & 2, TrouveLettreColonne([item_etab_titre]) & LastLignUsedInSheet("R_MoulinetteAValider"))
       tableau8() = Range(TrouveLettreColonne([descr_etab_titre]) & 2, TrouveLettreColonne([descr_etab_titre]) & LastLignUsedInSheet("R_MoulinetteAValider"))
       tableau9() = Range(TrouveLettreColonne([couleur_etab_titre]) & 2, TrouveLettreColonne([couleur_etab_titre]) & LastLignUsedInSheet("R_MoulinetteAValider"))
       tableau10() = Range(TrouveLettreColonne([four_etab_titre]) & 2, TrouveLettreColonne([four_etab_titre]) & LastLignUsedInSheet("R_MoulinetteAValider"))
       tableau11() = Range(TrouveLettreColonne([fournisseur_titre]) & 2, TrouveLettreColonne([fournisseur_titre]) & LastLignUsedInSheet("R_MoulinetteAValider"))
       tableau12() = Range(TrouveLettreColonne([marque_etab_titre]) & 2, TrouveLettreColonne([marque_etab_titre]) & LastLignUsedInSheet("R_MoulinetteAValider"))
       tableau13() = Range(TrouveLettreColonne([cat_etab_titre]) & 2, TrouveLettreColonne([cat_etab_titre]) & LastLignUsedInSheet("R_MoulinetteAValider"))
       tableau14() = Range(TrouveLettreColonne([format_contrat_titre]) & 2, TrouveLettreColonne([format_contrat_titre]) & LastLignUsedInSheet("R_MoulinetteAValider"))
       tableau15() = Range(TrouveLettreColonne([qte_an_titre]) & 2, TrouveLettreColonne([qte_an_titre]) & LastLignUsedInSheet("R_MoulinetteAValider"))
       tableau16() = Range(TrouveLettreColonne([prix_contrat_titre]) & 2, TrouveLettreColonne([prix_contrat_titre]) & LastLignUsedInSheet("R_MoulinetteAValider"))
       tableau17() = Range(TrouveLettreColonne([valider_etablissement_titre]) & 2, TrouveLettreColonne([valider_etablissement_titre]) & LastLignUsedInSheet("R_MoulinetteAValider"))
       tableau18() = Range(TrouveLettreColonne([commentaire_etablissement_titre]) & 2, TrouveLettreColonne([commentaire_etablissement_titre]) & LastLignUsedInSheet("R_MoulinetteAValider"))

     
 tableaux = Array(tableau1(), tableau2(), tableau3(), tableau4(), tableau5(), tableau6(), tableau7(), tableau8(), tableau9(), tableau10(), tableau11(), tableau12() _
          , tableau13(), tableau14(), tableau15(), tableau16(), tableau17(), tableau18())

   
'nettoie le nom des etablissements provenant du LAC afin d'éviter d'avoir 2 onglets


Worksheets("R_MoulinetteAValider").Activate

    Range(LettreVoulue & 2, LettreVoulue & LastLignUsedInSheet("R_MoulinetteAValider")).Select
    nettoyerseul
                                                       
'détruire onglet si ré-exécution de la macro
                            
    detruire_onglet_etablissement

'création des feuilles selon le nom des etablissement
    
    For Each nom_etablissement In Sheets("R_MoulinetteAValider").Range(LettreVoulue & 2, LettreVoulue & LastLignUsedInColumn(LettreVoulue))
    
    x = x + 1
        
        If Cells(x + 1, [valider_etablissement].Column) = "x" Or Cells(x + 1, [valider_etablissement].Column) = "X" Then
                
                If sheetExists(nom_etablissement.value) = True Then
                
                Else
            
                    Sheets.Add.Name = nom_etablissement
                    Sheets("R_MoulinetteAValider").[ID_titre].Copy Sheets(nom_etablissement.value).Range("a1")
                    Sheets("R_MoulinetteAValider").[seq_titre].Copy Sheets(nom_etablissement.value).Range("b1")
                    Sheets("R_MoulinetteAValider").[pair_impair_titre].Copy Sheets(nom_etablissement.value).Range("c1")
                    Sheets("R_MoulinetteAValider").[etab_titre].Copy Sheets(nom_etablissement.value).Range("d1")
                    Sheets("R_MoulinetteAValider").[acronyme_etab_titre].Copy Sheets(nom_etablissement.value).Range("e1")
                    Sheets("R_MoulinetteAValider").[item_etab_moulinette_titre].Copy Sheets(nom_etablissement.value).Range("f1")
                    Sheets("R_MoulinetteAValider").[item_etab_titre].Copy Sheets(nom_etablissement.value).Range("g1")
                    Sheets("R_MoulinetteAValider").[descr_etab_titre].Copy Sheets(nom_etablissement.value).Range("h1")
                    Sheets("R_MoulinetteAValider").[couleur_etab_titre].Copy Sheets(nom_etablissement.value).Range("i1")
                    Sheets("R_MoulinetteAValider").[four_etab_titre].Copy Sheets(nom_etablissement.value).Range("j1")
                    Sheets("R_MoulinetteAValider").[fournisseur_titre].Copy Sheets(nom_etablissement.value).Range("k1")
                    Sheets("R_MoulinetteAValider").[marque_etab_titre].Copy Sheets(nom_etablissement.value).Range("l1")
                    Sheets("R_MoulinetteAValider").[cat_etab_titre].Copy Sheets(nom_etablissement.value).Range("m1")
                    Sheets("R_MoulinetteAValider").[format_contrat_titre].Copy Sheets(nom_etablissement.value).Range("n1")
                    Sheets("R_MoulinetteAValider").[qte_an_titre].Copy Sheets(nom_etablissement.value).Range("o1")
                    Sheets("R_MoulinetteAValider").[prix_contrat_titre].Copy Sheets(nom_etablissement.value).Range("p1")
                    Sheets("R_MoulinetteAValider").[valider_etablissement_titre].Copy Sheets(nom_etablissement.value).Range("q1")
                    Sheets("R_MoulinetteAValider").[commentaire_etablissement_titre].Copy Sheets(nom_etablissement.value).Range("r1")
                    Sheets("R_MoulinetteAValider").[commentaire_etablissement_titre].Copy Sheets(nom_etablissement.value).Range("s1")
                                         
                     Range("s1").value = "Reponse de l'etablissement"
                     Columns("a:C").ColumnWidth = 6.11
                     Columns("D").ColumnWidth = 8.33
                     Columns("E").ColumnWidth = 15.78
                     Columns("F").ColumnWidth = 11.89
                     Columns("G").ColumnWidth = 15.78
                     Columns("H").ColumnWidth = 40
                     Columns("I:P").ColumnWidth = 15.78
                     Columns("Q").ColumnWidth = 11.89
                     Columns("R:U").ColumnWidth = 40
                
                     Range("a2").Activate
            
                End If
            
 'on copie les données dans la feuille correspondantes
            
'                    Sheets(nom_etablissement.value).Rows(x) = Application.Transpose(tableaux).Rows
'                    Debug.Print Join(tableaux, ";")
                   Sheets(nom_etablissement.value).Row(x).Resize(UBound(tableaux) + 1, 1) = Application.Transpose(tableaux(x, 1), tableaux)
        
        
'on supprime les lignes vides si bien sur les feuilles ont été créés
        
                    Sheets(nom_etablissement.value).Select
                    Range("A2").EntireRow.Insert
                    Sheets(nom_etablissement.value).Range("b1:B" & LastLignUsedInColumn("B")).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
                    With ActiveSheet.Tab
                        .ThemeColor = xlThemeColorAccent3
                        .TintAndShade = 0.399975585192419
                    End With
        End If
    
    Sheets("R_MoulinetteAValider").Select
    
    Next nom_etablissement

finish = Timer

MsgBox "durée du traitement: " & finish - start & " secondes"

Exit Sub

errorhandler:
MsgBox "Erreur d'exécution, la procédure va se terminer !", vbCritical


Erase tableau1
Erase tableau2
Erase tableau3
Erase tableau4
Erase tableau5
Erase tableau6
Erase tableau7
Erase tableau8
Erase tableau9
Erase tableau10
Erase tableau11
Erase tableau12
Erase tableau13
Erase tableau14
Erase tableau15
Erase tableau16
Erase tableau17
Erase tableau18
Erase tableaux

End Sub

dont la partie en rouge est le morceau manquant de mon casse-tête. Étant donné que le tableau contient des tableaux, je ne sais pas comment donné la valeur d'une ligne sinon j'Arrive a quelque chose de pas très efficaces soit

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
                    Sheets(nom_etablissement.value).Cells(x + 1, 1) = tableau1(x, 1)
                    Sheets(nom_etablissement.value).Cells(x + 1, 2) = tableau2(x, 1)
                    Sheets(nom_etablissement.value).Cells(x + 1, 3) = tableau3(x, 1)
                    Sheets(nom_etablissement.value).Cells(x + 1, 4) = tableau4(x, 1)
                    Sheets(nom_etablissement.value).Cells(x + 1, 5) = tableau5(x, 1)
                    Sheets(nom_etablissement.value).Cells(x + 1, 6) = tableau6(x, 1)
                    Sheets(nom_etablissement.value).Cells(x + 1, 7) = tableau7(x, 1)
                    Sheets(nom_etablissement.value).Cells(x + 1, 8) = tableau8(x, 1)
                    Sheets(nom_etablissement.value).Cells(x + 1, 9) = tableau9(x, 1)
                    Sheets(nom_etablissement.value).Cells(x + 1, 10) = tableau10(x, 1)
                    Sheets(nom_etablissement.value).Cells(x + 1, 11) = tableau11(x, 1)
                    Sheets(nom_etablissement.value).Cells(x + 1, 12) = tableau12(x, 1)
                    Sheets(nom_etablissement.value).Cells(x + 1, 13) = tableau13(x, 1)
                    Sheets(nom_etablissement.value).Cells(x + 1, 14) = tableau14(x, 1)
                    Sheets(nom_etablissement.value).Cells(x + 1, 15) = tableau15(x, 1)
                    Sheets(nom_etablissement.value).Cells(x + 1, 16) = tableau16(x, 1)
                    Sheets(nom_etablissement.value).Cells(x + 1, 17) = tableau17(x, 1)
                    Sheets(nom_etablissement.value).Cells(x + 1, 18) = tableau18(x, 1)

merci encore une fois pour votre aide précieuse !!!

Si je combine les 2 méthodes, j'ai toujours un erreur

J'arrive a quelquechose similaire a ça mais peut importe la façon que j'Essaie d'écrire, je frappe toujours a erreur d'exécution '424'

Code:

1
2
3
4
Sheets(nom_etablissement.value).Range("a" & x + 1, "r" & x + 1).Resize(1, 18) = Union(tableau1(x, 1), tableau2(x, 1), _
    tableau3(x, 1), tableau4(x, 1), tableau5(x, 1), tableau6(x, 1), tableau7(x, 1), tableau8(x, 1), tableau9(x, 1), _
    tableau10(x, 1), tableau11(x, 1), tableau12(x, 1), tableau13(x, 1), tableau14(x, 1), tableau15(x, 1), tableau16(x, 1), _
    tableau17(x, 1), tableau18(x, 1)).Resize(1, 18)

ou j'essaie comme ça

Code:

1
2
3
4
5
6
7
8
9
tableau_reponse = Array(tableau1(x, 1), tableau2(x, 1), tableau3(x, 1), tableau4(x, 1), tableau5(x, 1), _
                  tableau6(x, 1), tableau7(x, 1), tableau8(x, 1), tableau9(x, 1), tableau10(x, 1), _
                  tableau11(x, 1), tableau12(x, 1), tableau13(x, 1), tableau14(x, 1), tableau15(x, 1), _
                  tableau16(x, 1), tableau17(x, 1), tableau18(x, 1))
 
 
 
Debug.Print Join(tableau_reponse, ";")
Sheets(nom_etablissement.value).Range("a & x :s" & x) = Application.Transpose(tableau_reponse)

merci les alminches !!!!

28/09/2018, 23h32
Philippe Tulliez

Bonjour,

Citation:

TOus les exemple que j'ai vu prenait un tableau effectuais des tri et le copiais entièrement dans une nouvelle emplacement. Je n'ai malheureusement pas vu de cas auquel on appliquais un critère pour le resultats. Donc est ce possible ou avez vous une idée autre afin d'amélioré le code

Que souhaites-tu faire exactement ?
Est-ce copier des lignes d'une liste de données suivant un ou plusieurs critères vers une autre feuille ?

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