Sujet Précédent Sujet Suivant

Incrémentation Boucle à double variable

Résolu/Fermé
NcroPoney - 22 oct. 2018 à 16:29
 NecroPoney - 23 oct. 2018 à 17:41
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: 


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:

5 réponses

Réponse 1 / 5
jordane45 Messages postés 38314 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 24 novembre 2024 4 705
22 oct. 2018 à 16:47
Bonjour,

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=""

0
NcroPoney
23 oct. 2018 à 14:13
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.
0
Réponse 2 / 5
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 751
23 oct. 2018 à 10:05
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.
0
NecroPoney
Modifié le 23 oct. 2018 à 14:18 
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é.
0
Réponse 3 / 5
NecroPoney
23 oct. 2018 à 14:18
Et Merci à vous pour votre temps pijaku et jordane45
0
Réponse 4 / 5
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 751
23 oct. 2018 à 15:16
Juste 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
0
NecroPoney
23 oct. 2018 à 16:18
Merci beaucoup je vais essayer ca et je vous tiens au courant !

Mon programme doit a partir des valeurs d'une plage de données(CaseInfo), déterminer quels sont les noms (CaseEm) du personnel concerné ou non. Et copier ces noms dans une autre liste(CaseRec).
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 5
NecroPoney
23 oct. 2018 à 17:41
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 !
0

Discussions similaires

Mon pc s'allume et s'éteint en boucle
Jack -
Daniel -

16 réponses
recopier une formule sans décalage
aziz_alg80 -
aziz_alg80 -

2 réponses
comment ecrire un double cote " "
helmii -
[Dal] -

3 réponses