Mettre en place une boucle sur une macro existante
Bonjour à tous,
j'utilise une macro que Arturo83 m'avait généreusement fournit par le passé pour récolter des valeurs sur plusieurs feuilles et me les afficher sur une grille que voici :
Sub Resultat()
Dim i As Long, j As Long, Lig_Dest As Long, Col_Dest As Long
Dim Seuil_Bas As Long, Seuil_Haut As Long, Maxi As Long, Mini As Long
Application.ScreenUpdating = False
Sh_Res.Range("C7:AU28").ClearContents 'effacement des précédents résultats
Seuil_Haut = Sh_Res.Range("B1").Value
Seuil_Bas = Sh_Res.Range("B2").Value
Maxi = Sh_Res.Range("B3").Value
Mini = Sh_Res.Range("B4").Value
Lig_Dest = 7 'première ligne de la feuille "Resultat" ou sera recopiée les valeurs
For i = 9 To Sheets.Count
Col_Dest = 3 'première colonne de la feuille "Resultat" ou sera recopiée les valeurs
'Application des formules pour trouver les valeurs à exporter vers la feuille "Resultat"
Sheets(i).Range("DD55:EV55").FormulaR1C1 = "=R[-3]C[-105]"
Sheets(i).Range("DD57:EV57").FormulaR1C1 = "=COUNTIF(R[-55]C:R[-5]C,MAX(R[-55]C:R[-5]C))"
Sheets(i).Range("DD52:EV52").FormulaR1C1 = "=Sum(R[0]C[-48]:R[-50]C[-48])"
'Exportation des valeurs comprises dans les seuils
For j = 108 To 152 'de la colonne 19 à 49
If Sheets(i).Cells(57, j) >= Seuil_Bas And Sheets(i).Cells(57, j) <= Seuil_Haut And Sheets(i).Cells(52, j) >= Mini And Sheets(i).Cells(52, j) <= Maxi Then
Sh_Res.Cells(Lig_Dest, Col_Dest).Value = Sheets(i).Cells(55, j).Value
Col_Dest = Col_Dest + 1 'colonne suivante de la feuille "Resultat" ou sera recopiée les valeurs
End If
Next j
Sh_Res.Cells(Lig_Dest, "B").Value = Sheets(i).Name 'copie le nom de la feuille traitée en colonne B
Lig_Dest = Lig_Dest + 1 'ligne suivante de la feuille "Resultat" ou sera recopiée les valeurs
Next i
End SubPuis je renseigne sur ma feuille en B1, B2, B3, B4 les paramètres pour la récolte de valeurs..
Ensuite à l'aide d'une autre macro fournit également par Arturo83, je classe les valeurs récoltés en ligne et m'affiche aussi les valeurs inexistant de la récolte que voici :
Sub EnLigne()
Dim DerLig As Long, DerCol As Long, i As Long, Col_Dest_Exist As Long, Col_Dest_NonExist As Long
Dim NbExist As Long, NbNonExist As Long
Application.ScreenUpdating = False
Rows("32:34").ClearContents 'Effacement des précédents résultats
Col_Dest_Exist = 3 'première colonne libre pour résultat des valeurs existantes
Col_Dest_NonExist = 3 'première colonne libre pour résultat des valeurs inexistantes
DerLig = Range("B" & Rows.Count).End(xlUp).Row 'Dernière ligne de la liste
DerCol = Range(Cells(7, "C"), Cells(DerLig, 100)).SpecialCells(xlCellTypeLastCell).Column 'Dernière colonne de la liste
For i = 1 To 40 'pour le numéros de 1 à 40
NbExist = Application.WorksheetFunction.CountIf(Range(Cells(7, "C"), Cells(DerLig, DerCol)), i) 'on compte le nombre de fois ou l'on trouve le numéro recherché
If NbExist = 0 Then 'si le nombre de fois est égal à 0, alors:
Cells(34, Col_Dest_NonExist).Value = i 'on l'inscrit sur la ligne 34
Col_Dest_NonExist = Col_Dest_NonExist + 1 'on incrémente de 1 la nouvelle colonne de destination
Else 'sinon:
Range(Cells(32, Col_Dest_Exist), Cells(32, Col_Dest_Exist + NbExist - 1)).Value = i 'on recopie le numéro trouvé autant de fois qu'il existe
Col_Dest_Exist = Col_Dest_Exist + NbExist 'on incrémente le numéro de la dernière colonne du nombre de fois où le numéro à été trouvé
End If
Next i 'on cherche le numéro suivant
End SubJusque là tout fonctionne à merveille, sauf que avec le temps je dois effectuer de plus en plus de calcul en renseignant à chaque fois en B1, B2 de la macro RESULTAT des valeurs différents pour ensuite les copier coller sur une autre feuille ou je les classes et cela devient redondant d’où mon idée de pouvoir renseigner une "plage de valeurs" en B1 et B2 ou il pourrait y avoir une boucle et me les afficher à la suite avec un saut de 8 lignes par résultat et par la même occasion me calculer les résultats de la macro ENLIGNE sur cette même boucle.
Donc pour résumer l'objectif est de fusionner les 2 macros et faire en sorte que en B1 et B2 soient bouclés en gardant les paramètres de B3 et B4 pour qu'au lieu de faire exemple, si je renseigne B1=20 et B2=1 de (B2 à B1) le résultat sera 1 à 20, 2, 20, 3,20 jusqu'à 20 20 sur une grille, puisse me faire B1=20 B2=1, résultat sera 1 1, 2 2, 3 3, 4,4 jusqu'à 20 20 sur plusieurs grilles en gardant les paramètres de B3 et B4 avec un saut de 8 lignes par résultat (1 1 saut 8 ligne, 2 2 saut 8 ligne, etc..) et inclure le classement ENLIGNE.
Pour avoir encore une meilleure clarté de ma demande j'ai illustré sur une démo le processus de fonctionnement que j'aimerais faire. (La démo n'est pas fonctionnelle, c'est juste visuel pour la compréhension du processus)
Au vu de la complexité de la modification à effectuer du code pour mon niveau en VBA , je sollicite votre aide car cela me facilitera grandement dans mes taches pour mon travail..
Si vous pouvez me fournir un code remodelé avec votre savoir faire pour accomplir ma requête ce serait très apprécié
En vous remerciant par avance de m'avoir lu.
Bonjour,
Pouvez-vous joindre le fichier original d'Arturo ainsi que le lien vers le fil en question ? Merci.
Un peu difficile à appréhender sans, surtout que certaines variables sont nommées "en dur".
Bonjour Saboh12617, merci pour votre participation et oui bien sûr que je peux mettre le lien vers le fil en question que voici :
Vous trouverez en téléchargement le fichier que Arturo83 m'avait proposé avec les petites modifications qui ont suivi..
J'avais par ailleurs pensé à remonter le fil de discussion en question en postant dessus, puisque c'est Arturo83 qui avait écrit le code mais comme le sujet était résolu je n'ai pas osé et peut être que je me serait fait "grondé" par un modérateur
Et je sais qu'il y a beaucoup de personnes doués en Excel sur ce forum dont vous aussi j'imagine et comme le vous dites si bien il est souvent difficile d'appréhender le sens d'un code ou une demande d'aide, et c'est pourquoi je met toujours une petite démo ou j’explique au mieux mon problème mais souvent cela ne suffit pas et je comprends tout à fait.
Si vous avez d'autres questions n'hésitez pas
J'ai refait une démo pleinement fonctionnel (j'y ai passé la journée à adapter le code
j’espère trouver la solution grâce à vous car j'ai eu beau essayer avec des tutos et de multiples essais, je ne sais pas comment appliquer une boucle dans ce cas ci..