Incrémentation Boucle à double variable
Résolu
NcroPoney
-
NecroPoney -
NecroPoney -
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.
A voir également:
- Incrémentation Boucle à double variable
- Double ecran - Guide
- Whatsapp double sim - Guide
- Double driver - Télécharger - Pilotes & Matériel
- Double appel - Guide
- Double boot - Guide
5 réponses
Bonjour,
Remplace
par
idem pour
Remplace
Do While Not IsEmpty(CaseInfo) 'Tant que Liste Info non vide
par
Do While Not CaseInfo = "" 'Tant que Liste Info non vide
idem pour
Do While Not IsEmpty(CaseEm)
Do While Not CaseEm=""
NcroPoney
J'ai essayé toujours le meme problème... Il me copie seulement la première case de la colonne 1 jusqu'a ligneFin atteigne sa valeur max.
Bonjour,
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.
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é.
Juste se pencher sur ce bout de code :
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 :
Par exemple (ce n'est qu'un exemple car je ne sais pas ce que tu veux faire) :
Dernière chose, pour tester une cellule vide, plutôt que :
Il vaut toujours mieux utiliser les constantes adéquates ET la propriété Value (ou Text) de l'objet :
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
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
