Boucle While dans boucle While

Question

Depuis quelques temps maintenant, j'essaye de me perfectionner en VBA. Aussi, régulièrement dans le cadre de mes projets au travail, j'essaye au plus possible de faire du VBA. Lorsque je rencontre un point de difficulté, en général en farfouillant sur internet j'arrive à trouver une solution. Mais voilà, aujourd'hui internet me fait défaut. Bon en vrai je pense que le vrai problème n'est pas internet mais plutôt la chose qu'il y a entre le PC et la chaise de bureau ^^. Je ne parviens pas à trouver les termes qui expliquerai en quelques mots mon problème. Du coup, je n'arrive pas à chercher bien ^^. Fin bref, tout ça pour dire : les amis je m'en remets à votre gentillesse et bienveillance pour aider une pauvre aire comme moi. ^^. Voici mon problème : J'ai un fichier Excel avec 3 feuilles (2 seront utile ici). Ce fichier me sert à organiser tout un plan de tests. Pour faire simple : J’ai des pièces qui doivent être testées. Ces pièces sont donc assemblées puis testées. Il existe une multitude d’assemblage de pièces différentes: Ces assemblages sont appelés dans mon fichier « Groupe » (en réel j’ai 396 groupes – pour simplifier j’ai réduit ici à 7 groupes ^^. Chaque groupe subit donc ensuite une série de test. Cependant, tous les groupes ne subissent pas les mêmes testes et pas forcément dans le même ordre. Dans mon fichier, l’ordre des tests est définit par « sub-group ». Et le test en lui-même est nommé dans « test » feuille 1 = "Tout" Dans cette feuille, on retrouve toute les informations. Chaque ligne correspond à 1 test pour 1config. feuille 2 = "Plan de test_DVP" Dans cette feuille, chaque ligne correspond à une config seulement. Et l’idée est que dans cette ligne, on puisse voir l’ordre des essais pour cette config. Je m’explique en colonne B il y a le N° de groupe (= « N° du plan de test »). Les colonnes G à Q correspondent chacune à un essai. L’idée est que pour chaque configuration (groupe), je puisse voir dans la cellule sous chaque test si la config doit avoir ce test et à quel moment faire ce test (en position a, b, c, ...) Du coup , le code que j’ai fait doit normalement remplir les lettres a, b, c, … dans le tableau de la feuille « plan de test_DVP ». Le souci est là. Quand je lance mon module ( lié à un bouton), il ne se passe rien. Et je ne sais pas du tout pourquoi ☹. voici le code : Sub MàJ() Deb_lign_plan = 28 Deb_Col_plan = 7 Deb_lign_tout = 13 While Sheets("Plan de test_DVP").Cells(Deb_lign_plan, 2) = Sheets("Tout").Cells(Deb_lign_tout, 1) While Sheets("plan de test_DVP").Cells(27, Deb_Col_plan).Value &lt;&gt; Sheets("Tout").Cells(Deb_lign_tout, 5) Deb_Col_plan = Deb_Col_plan + 1 Wend Sheets("plan de test_DVP").Cells(28, Deb_Col_plan).Value = Sheets("Tout").Cells(Deb_lign_tout, 2) Deb_lign_tout = Deb_lign_tout + 1 Wend Deb_lign_plan = Deb_lign_plan + 1 End Sub Voila, j'espère sincèrement que vous pourrais m'aider. Je vous souhaite à tous un bon appétit et une bonne journée. cdt...

Curulis · Accepted Answer

Comme quoi, à l'aveugle, pas facile avec notre petit cerveau humain... J'ai déplacé le code vers le module VBA de 'Plan de test_DVP' et supprimé 'Module 2'. La macro démarre sur un double-clic sur la feuille 'Plan de test_DVP' EDIT : au fait, combien de lignes de tests à lire y a-t-il d'habitude ? Si c'est trop long, il faudra passer par des tableaux... À toi de dire! Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) ' Dim rCel As Range, iRow%, iRowT% ' Cancel = True Application.ScreenUpdating = False ' With Worksheets("Tout") 'Avec la feuille "tout" For x = 13 To .Range("A" & Rows.Count).End(xlUp).Row 'pour x= 13 jusqu'à la dernière ligne remplie iRow = .Columns(1).Find(what:=Format(.Range("A" & x).Value, "000"), lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlPrevious).Row 'cherche la dernière ligne de même code en &#91;A:A&#93; iRowT = Columns(2).Find(what:=Format(.Range("A" & x).Value, "000"), lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Row 'cherche la ligne correspondante dans 'Plan de test DVP' Cells(iRowT, 7).Resize(1, 11).Value = "" 'effacement des anciennes valeurs For y = x To iRow 'lecture des tests dans 'Tout' Set rCel = Rows(27).Find(what:=.Range("E" & y).Value, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext) 'cherche la colonne du test If Not rCel Is Nothing Then _ Cells(iRowT, rCel.Column) = IIf(Cells(iRowT, rCel.Column) &lt;&gt; "", Cells(iRowT, rCel.Column) & " / ", "") & Right(.Range("D" & y).Value, 1) 'écriture Next x = iRow 'mise à jour de x pour continuer la boucle Next End With ' Application.ScreenUpdating = True ' End Sub A+...

Curulis · Answer

A l'aveugle malgré tes jolies photos... Si ça foire,... envoie ton fichier... puisque tu l'as fait !! Sub MàJ() ' Dim sWkDVP As Worksheet, rCel As Range, iRow%, iRowT% ' Set sWkDVP = Worksheets("Plan de test_DVP") ' With Worksheets("Tout") For x = 13 To .Range("A" & Rows.Count).End(xlUp).Row iRow = .Columns(1).Find(what:=.Range("A" & x).Value, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlPrevious).Row iRowT = sWkDVP.Columns(2).Find(what:=.Range("A" & x).Value, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Row For y = x To iRow Set rCel = sWkDVP.Rows(27).Find(what:=.Range("E" & y).Value, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext) If Not rCel Is Nothing Then Cells(iRowT, rCel.Column) = IIf(Cells(iRowT, rCel.Column) &lt;&gt; "", " / ", "") & Right(.Range("D" & y).Value, 1) Next x = iRow Next End With ' End Sub A+...

Curulis · Answer

Réaliser ces calculs par "tableaux" revient à faire les calculs en RAM (mémoire vive de l'ordi) donc quasi instantanément...

- Combien de fois par jour dois-tu faire ces calculs ?
- Combien de secondes faut-il pour réaliser la MÀJ avec mon code quand 'Tout' est plein à ras-bord ?

A+

Curulis · Answer

Oh, doucement, on ne programme pas directement la RAM : on utilise des variables-tableau.
Pour imager, on saisit dans cette variable-tableau une Range de valeurs et, au lieu de travailler sur la feuille, par affichages successifs très chronophages, on réalise d'abord les calculs "en mémoire" et ensuite, on affiche en une fois les résultats.

Je te fais ça dans la foulée...
Seul souci de taille : tu n'auras plus le temps de même seulement penser à un café ! C'est bête, hein ?

A+

Curulis · Answer

Rien de sorcier dans un tableau!
En gros, c'est une grille de valeurs correspondant au Range que tu as "capté" et à laquelle tu donnes un nom.
Ici, tTab ("t" = "t"ableau : une habitude de préfixer mes variables) = le tableau Tab(leau) : difficile, hein ?
tExtract est, quasi toujours, le nom que je donne au tableau des résultats (Extraction de données).

Un tableau range ses valeurs comme Excel : par lignes et colonnes (bon, pas toujours, mais, une chose à la fois...)
La seule "magie" est de comprendre que, même si tu captures, par ex. tTab = [B7:E18], tTab(1,1) sera égal à [B7], c-à-d, la première cellule de la Range capturée.
C'est la seule gymnastique à intégrer dans nos pauvres esprits humains.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tTab, tExtract
'
Cancel = True
Application.ScreenUpdating = False
'
tTab = Worksheets("Tout").Range("A13:E" & Worksheets("Tout").Range("A" & Rows.Count).End(xlUp).Row).Value   ' = tableau de 'Tout'
Range("G28:Q" & Range("B" & Rows.Count).End(xlUp).Row).Value = ""           'effacement du détail des tests précédents...
tExtract = Range("B27:Q" & Range("B" & Rows.Count).End(xlUp).Row).Value     '...histoire d'affecter un tableau vierge à tExtract
'
For x = 1 To UBound(tTab, 1)                'lecture des données de tTab
    For y = 6 To UBound(tExtract, 2)        'recherche du libellé du test dans tExtract et écriture
        If tTab(x, 5) = tExtract(1, y) Then _
            tExtract(CInt(tTab(x, 1)) + 1, y) = _
                IIf(tExtract(CInt(tTab(x, 1)) + 1, y) <> "", tExtract(CInt(tTab(x, 1)) + 1, y) & " / ", "") & Right(tTab(x, 4), 1)
    Next
Next
Range("B27").Resize(UBound(tExtract, 1), UBound(tExtract, 2)).Value = tExtract      'affichage de tExtract après calculs
'
Application.ScreenUpdating = True
'
End Sub

- donc, ici, je capte 'Tout' [A13:Exx] dans tTab : pas besoin de plus puisque l'intitulé du test se trouve en colonne [E:E] ;
- dans 'Plan de test_DVP', j'efface d'abord d'anciens résultats dans [G28:Qxx] ;
- puis je place dans tExtract [B27:Qxx] l'ensemble du Range, donc tExtract(1,1)= " N°du plan de test" ;
- pourquoi [B27] et pas [B28] ? Parce que, ainsi, j'ai à ma disposition, "en mémoire", les intitulés des tests en ligne 27 ;
- UBound(tTab, 1) = limite supérieure du nombre de lignes d'un tableau ;
- UBound(tExtract, 2) = limite supérieure du nombre de colonnes d'un tableau ;
- la boucle x lit tTab, ligne par ligne ;
- la boucle y compare tTab(x,1) = Range("A" & x).value avec tExtract(1-ère ligne, la 27-, index de 6 à 16 = colonnes G à Q) pour trouver le bon test ;
- une chose à savoir : les données d'un tableau sont des Variant, c-à-d, qu'elles acceptent tous types de données ;
- donc, quand il s'agit de faire, par ex. des opérations mathématiques entre valeurs de tableau, il vaut mieux, crois-moi, les convertir au mieux. Ici, histoire de tomber sur le bon index de tExtract, je convertis tTab(x,1) en Cint(tTab(x,1)) = en Integer (nombre entier) ;
- écriture dans tExtract. Tu peux lire : tExtract(CInt(tTab(x, 1)) + 1, y ): pourquoi ?
- parce que la ligne 1 de tExtract est la ligne des intitulés des tests. Le plan de test 001 commence donc en fait en tExtract(1 + 1,...) = en 2e ligne de tExtract.

Quand je te parle de gymnastique...

La seule obligation, dans ce code (mais on peut tout adapter), est la certitude d'avoir des n° de test chronologiques !!!!!!! 001, 002, 003, 004... Si tel n'est pas TOUJOURS le cas, il faudra adapter...

Espérant avoir pu être un brin pédagogue...

15kiwi.xlsm (71.42 Ko)

A+