Incrémentation Boucle à double variable
Résolu
Bonjour,
J'ai un problème lors de ma compilation, je pense que mon programme est bon dans sa logique mais qu'il y une erreur de syntaxe sauf que je ne trouve pas ou :
Pour faire simple j'ai deux feuilles :
IMPRESSION: Sur cette feuille j'ai une plage de cellule (Liste/INFO) (O3 : On) qui correspond à la condition (si présence du mot "LABO" alors...). J'ai aussi une autre plage(Fin/Rec) qui doit être rempli par mon programme ( A7:An).
DONNEES: Cette feuille stock les valeurs (Données/Em) que je souhait remplir.
Voici mon code:
PS: J'ai essayé de redéfinir CaseEm dans la boucle adéquate sans succès
Ce programme copie juste la case mais continu d'incrémenter ligneFin et ligneDonnées jusqu'a la valeur max et s'arret.
Je ne sais pas si j'ai été bien clair, auquel cas dites le moi. Merci d'avance de votre temps.
J'ai un problème lors de ma compilation, je pense que mon programme est bon dans sa logique mais qu'il y une erreur de syntaxe sauf que je ne trouve pas ou :
Pour faire simple j'ai deux feuilles :
IMPRESSION: Sur cette feuille j'ai une plage de cellule (Liste/INFO) (O3 : On) qui correspond à la condition (si présence du mot "LABO" alors...). J'ai aussi une autre plage(Fin/Rec) qui doit être rempli par mon programme ( A7:An).
DONNEES: Cette feuille stock les valeurs (Données/Em) que je souhait remplir.
Voici mon code:
ligneListe = 3
ligneDonnées = 2
ligneFin = 7
ColonneDonnées = 1'''''''''''''''''' garde cette valeur tout au long du prog.
Dim ligneListe As Integer
Dim ligneDonnées As Integer
Dim ligneFin As Integer
Dim ColonneDonnées As Integer
Dim CaseInfo As Range
Dim CaseEm As Range
Dim CaseRec As Range
Set CaseInfo = Worksheets("IMPRESSION").Cells(ligneListe, 15)
Set CaseEm = Worksheets("Données").Cells(ligneDonnées, ColonneDonnées)
Set CaseRec = Worksheets("IMPRESSION").Cells(ligneFin, 1)
Do While Not IsEmpty(CaseInfo) 'Tant que Liste Info non vide
If CaseInfo.Value Like "*LABO*" Then 'Si LABO
ColonneDonnées = 2
Do While Not IsEmpty(CaseEm) ''''''''''''''''''''''''''''''''''''''Ne comprend pas la commande à cause de la double variable de CaseEm ?
CaseRec.Value = CaseEm.Value 'Copier sur liste final avec incrémentation liste fin ET liste personnel
ligneFin = ligneFin + 1
ligneDonnées = ligneDonnées + 1
Loop
ligneListe = ligneListe + 1
ligneDonnées = 2
End If
'Autre boucle pour autre mot avec autre ColonneDonnées.....
Loop
End Sub
PS: J'ai essayé de redéfinir CaseEm dans la boucle adéquate sans succès
Ce programme copie juste la case mais continu d'incrémenter ligneFin et ligneDonnées jusqu'a la valeur max et s'arret.
Je ne sais pas si j'ai été bien clair, auquel cas dites le moi. Merci d'avance de votre temps.
5 réponses
-
Parfait ! Effectivement le problème venez de mes variables que je ne déclarais pas par la suite.
Merci quand même pour les fautes de syntaxe j'y ferai attention. Merci beaucoup a vous deux particulièrement a toi pijaku !
Bonne continuation ! -
ModérateurJuste se pencher sur ce bout de code :
Set CaseInfo = Worksheets("IMPRESSION").Cells(ligneListe, 15) Set CaseEm = Worksheets("Données").Cells(ligneDonnées, ColonneDonnées) Set CaseRec = Worksheets("IMPRESSION").Cells(ligneFin, 1) Do While Not CaseInfo = "" 'Tant que Services concernées non vide If CaseInfo.Value Like "*LABO*" Then 'Si LABO ColonneDonnées = 2 Do While Not CaseEm = "" '!!!!!!!!!! Ne comprend pas la commande à cause de la double variable ? / Si liste personnel non vide CaseRec.Value = CaseEm.Value 'Copier sur liste final avec incrémentation liste fin ET liste personnel ligneFin = ligneFin + 1 ligneDonnées = ligneDonnées + 1 If CaseInfo.Value Like "*DIR*" Then 'Si DIR ColonneDonnées = 3 Do While Not CaseEm = "" '!!!!!!!!!! Ne comprend pas la commande à cause de la double variable ? / Si liste personnel non vide CaseRec.Value = CaseEm.Value 'Copier sur liste final avec incrémentation liste fin ET liste personnel ligneFin = ligneFin + 1 ligneDonnées = ligneDonnées + 1 Loop ligneListe = ligneListe + 1 ligneDonnées = 2 End If Loop
Do While Not CaseEm = "" '!!!!!!!!!! Ne comprend pas la commande
==> Non. Tu initie une boucle (Do While) que tu ne "fermes" pas (absence de Loop pour cette boucle)/
Il manque un End If ou un ElseIf au choix au test :
If CaseInfo.Value Lile "*LABO*"
Dans aucune des boucles tu n'incrémentes tes cellules CaseInfo, CaseEm et CaseRec.
Tu incrémentes bien les variables lignes et colonnes, mais tu ne les attribues pas à tes cellules.
Il faut, dans ta boucle ou dans tes boucles, retrouver ces lignes de code :Set CaseInfo = Worksheets("IMPRESSION").Cells(ligneListe, 15) Set CaseEm = Worksheets("Données").Cells(ligneDonnées, ColonneDonnées) Set CaseRec = Worksheets("IMPRESSION").Cells(ligneFin, 1)
Par exemple (ce n'est qu'un exemple car je ne sais pas ce que tu veux faire) :
Set CaseInfo = Worksheets("IMPRESSION").Cells(ligneListe, 15) Set CaseEm = Worksheets("Données").Cells(ligneDonnées, ColonneDonnées) Set CaseRec = Worksheets("IMPRESSION").Cells(ligneFin, 1) Do While Not CaseInfo = "" 'Tant que Services concernées non vide If CaseInfo.Value Like "*LABO*" Then 'Si LABO ColonneDonnées = 2 Set CaseEm = Worksheets("Données").Cells(ligneDonnées, ColonneDonnées) Do While Not CaseEm = "" CaseRec.Value = CaseEm.Value ligneFin = ligneFin + 1 ligneDonnées = ligneDonnées + 1 Set CaseEm = Worksheets("Données").Cells(ligneDonnées, ColonneDonnées) Set CaseRec = Worksheets("IMPRESSION").Cells(ligneFin, 1) Loop ElseIf CaseInfo.Value Like "*DIR*" Then 'Si DIR ColonneDonnées = 3 Set CaseEm = Worksheets("Données").Cells(ligneDonnées, ColonneDonnées) Do While Not CaseEm = "" CaseRec.Value = CaseEm.Value ligneFin = ligneFin + 1 ligneDonnées = ligneDonnées + 1 Set CaseEm = Worksheets("Données").Cells(ligneDonnées, ColonneDonnées) Set CaseRec = Worksheets("IMPRESSION").Cells(ligneFin, 1) Loop End If ligneListe = ligneListe + 1 ligneDonnées = 2 Set CaseInfo = Worksheets("IMPRESSION").Cells(ligneListe, 15) Set CaseEm = Worksheets("Données").Cells(ligneDonnées, ColonneDonnées) Loop
Dernière chose, pour tester une cellule vide, plutôt que :Do While Not CaseEm = ""
Il vaut toujours mieux utiliser les constantes adéquates ET la propriété Value (ou Text) de l'objet :Do While Not CaseEm.Value = vbNullString
-
Et Merci à vous pour votre temps pijaku et jordane45
-
ModérateurBonjour,
Le code présenté ici n'est certainement pas un copié-collé de ton code.
S'il te plait, place nous donc ici le vrai code, celui que tu utilises, à partir de Sub ... jusqu'à End Sub.
Merci.
-
Option Explicit Sub Impression() Dim Col As Integer Dim CaseCond As Range Dim CaseAffich As Range Dim ImpFin As Worksheet Dim Doc01 As Worksheet Dim Doc02 As Worksheet Dim Doc03 As Worksheet Dim Doc04 As Worksheet Dim Doc05 As Worksheet Dim Doc06 As Worksheet Dim Doc07 As Worksheet Dim Doc08 As Worksheet Dim Données As Worksheet Dim ligneListe As Integer Dim ligneDonnées As Integer Dim ligneFin As Integer Dim ColonneDonnées As Integer Dim CaseInfo As Range Dim CaseEm As Range Dim CaseRec As Range Set ImpFin = Worksheets("IMPRESSION") 'Déclaration feuille d'impression Set Doc01 = Worksheets("DocRH") Set Doc02 = Worksheets("DocLABO") Set Doc03 = Worksheets("DocMQ") Set Doc04 = Worksheets("DocPROD") Set Doc05 = Worksheets("DocACHAT") Set Doc06 = Worksheets("DocMAGA") Set Doc07 = Worksheets("DocMAIN") Set Doc08 = Worksheets("DocADV") Set Données = Worksheets("Données") Set CaseCond = Worksheets("IMPRESSION").Cells(4, 1) 'Cellule condition Set CaseAffich = Worksheets("IMPRESSION").Cells(4, 5) 'Cellule d'affichage 'Titre'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If CaseCond.Value Like "*RH*" Then 'Si la case d'enregistrement affiche RH Doc01.Activate End If If CaseCond.Value Like "*LABO*" Then Doc02.Activate End If If CaseCond.Value Like "*MQ*" Then Doc03.Activate End If If CaseCond.Value Like "*PROD*" Then Doc04.Activate End If If CaseCond.Value Like "*ACHAT*" Then Doc05.Activate End If If CaseCond.Value Like "*MAGA*" Then Doc06.Activate End If If CaseCond.Value Like "*MAIN*" Then Doc07.Activate End If If CaseCond.Value Like "*ADV*" Then Doc08.Activate End If If CaseCond.Value Like "*PRD*" Then 'Si la case d'enregistrement affiche PRD Col = 1 End If If CaseCond.Value Like "*INT*" Then Col = 2 End If If CaseCond.Value Like "*FIC*" Then Col = 3 End If If CaseCond.Value Like "*FOR*" Then Col = 4 End If If CaseCond.Value Like "*PRC*" Then Col = 5 End If If CaseCond.Value Like "*01*" Then CaseAffich.Value = Cells(1, Col).Value End If If CaseCond.Value Like "*02*" Then CaseAffich.Value = Cells(2, Col).Value End If If CaseCond.Value Like "*03*" Then CaseAffich.Value = Cells(3, Col).Value End If If CaseCond.Value Like "*04*" Then CaseAffich.Value = Cells(4, Col).Value End If If CaseCond.Value Like "*05*" Then CaseAffich.Value = Cells(5, Col).Value End If If CaseCond.Value Like "*06*" Then CaseAffich.Value = Cells(6, Col).Value End If If CaseCond.Value Like "*07*" Then CaseAffich.Value = Cells(7, Col).Value End If If CaseCond.Value Like "*08*" Then CaseAffich.Value = Cells(8, Col).Value End If If CaseCond.Value Like "*09*" Then CaseAffich.Value = Cells(9, Col).Value End If If CaseCond.Value Like "*10*" Then CaseAffich.Value = Cells(10, Col).Value End If If Cells(4, 1).Value Like "*11*" Then CaseAffich.Value = Cells(11, Col).Value End If If Cells(4, 1).Value Like "*12*" Then CaseAffich.Value = Cells(12, Col).Value End If If Cells(4, 1).Value Like "*13*" Then CaseAffich.Value = Cells(13, Col).Value End If If Cells(4, 1).Value Like "*14*" Then CaseAffich.Value = Cells(14, Col).Value End If If Cells(4, 1).Value Like "*15*" Then CaseAffich.Value = Cells(15, Col).Value End If If Cells(4, 1).Value Like "*16*" Then CaseAffich.Value = Cells(16, Col).Value End If If Cells(4, 1).Value Like "*17*" Then CaseAffich.Value = Cells(17, Col).Value End If If Cells(4, 1).Value Like "*18*" Then CaseAffich.Value = Cells(18, Col).Value End If If Cells(4, 1).Value Like "*19*" Then CaseAffich.Value = Cells(19, Col).Value End If If Cells(4, 1).Value Like "*20*" Then CaseAffich.Value = Cells(20, Col).Value End If If Cells(4, 1).Value Like "*21*" Then CaseAffich.Value = Cells(21, Col).Value End If If Cells(4, 1).Value Like "*22*" Then CaseAffich.Value = Cells(22, Col).Value End If If Cells(4, 1).Value Like "*23*" Then CaseAffich.Value = Cells(23, Col).Value End If If Cells(4, 1).Value Like "*24*" Then CaseAffich.Value = Cells(24, Col).Value End If If Cells(4, 1).Value Like "*25*" Then CaseAffich.Value = Cells(25, Col).Value End If If Cells(4, 1).Value Like "*26*" Then CaseAffich.Value = Cells(26, Col).Value End If If Cells(4, 1).Value Like "*27*" Then CaseAffich.Value = Cells(27, Col).Value End If If Cells(4, 1).Value Like "*28*" Then CaseAffich.Value = Cells(28, Col).Value End If If Cells(4, 1).Value Like "*29*" Then CaseAffich.Value = Cells(29, Col).Value End If If Cells(4, 1).Value Like "*30*" Then CaseAffich.Value = Cells(30, Col).Value End If If Cells(4, 1).Value Like "*31*" Then CaseAffich.Value = Cells(31, Col).Value End If If Cells(4, 1).Value Like "*32*" Then CaseAffich.Value = Cells(32, Col).Value End If If Cells(4, 1).Value Like "*33*" Then CaseAffich.Value = Cells(33, Col).Value End If If Cells(4, 1).Value Like "*34*" Then CaseAffich.Value = Cells(34, Col).Value End If If Cells(4, 1).Value Like "*35*" Then CaseAffich.Value = Cells(35, Col).Value End If If Cells(4, 1).Value Like "*36*" Then CaseAffich.Value = Cells(36, Col).Value End If If Cells(4, 1).Value Like "*37*" Then CaseAffich.Value = Cells(37, Col).Value End If If Cells(4, 1).Value Like "*38*" Then CaseAffich.Value = Cells(38, Col).Value End If If Cells(4, 1).Value Like "*39*" Then CaseAffich.Value = Cells(39, Col).Value End If If Cells(4, 1).Value Like "*40*" Then CaseAffich.Value = Cells(40, Col).Value End If If Cells(4, 1).Value Like "*41*" Then CaseAffich.Value = Cells(41, Col).Value End If If Cells(4, 1).Value Like "*42*" Then CaseAffich.Value = Cells(42, Col).Value End If ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'Services concernés'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ImpFin.Activate ligneListe = 3 ligneDonnées = 2 ligneFin = 7 ColonneDonnées = 1 ' !!!!!! garde la valeur tout au long du prog. Set CaseInfo = Worksheets("IMPRESSION").Cells(ligneListe, 15) Set CaseEm = Worksheets("Données").Cells(ligneDonnées, ColonneDonnées) Set CaseRec = Worksheets("IMPRESSION").Cells(ligneFin, 1) Do While Not CaseInfo = "" 'Tant que Services concernées non vide If CaseInfo.Value Like "*LABO*" Then 'Si LABO ColonneDonnées = 2 Do While Not CaseEm = "" '!!!!!!!!!! Ne comprend pas la commande à cause de la double variable ? / Si liste personnel non vide CaseRec.Value = CaseEm.Value 'Copier sur liste final avec incrémentation liste fin ET liste personnel ligneFin = ligneFin + 1 ligneDonnées = ligneDonnées + 1 If CaseInfo.Value Like "*DIR*" Then 'Si DIR ColonneDonnées = 3 Do While Not CaseEm = "" '!!!!!!!!!! Ne comprend pas la commande à cause de la double variable ? / Si liste personnel non vide CaseRec.Value = CaseEm.Value 'Copier sur liste final avec incrémentation liste fin ET liste personnel ligneFin = ligneFin + 1 ligneDonnées = ligneDonnées + 1 Loop ligneListe = ligneListe + 1 ligneDonnées = 2 End If Loop ImpFin.Activate 'Si vide stop End Sub
Voici la totalité de mon code j'ai une boucle précédente me permettant de remplir une case en fonction de différents mot dans une autre case. Peut etre que c'est lié.
-
-
ModérateurBonjour,
RemplaceDo While Not IsEmpty(CaseInfo) 'Tant que Liste Info non vide
parDo While Not CaseInfo = "" 'Tant que Liste Info non vide
idem pourDo While Not IsEmpty(CaseEm)
Do While Not CaseEm=""
