Boucle qui ne veut pas s'exécuter ?

[dmoluc]

Bonjour à tous,

je suis toujours bloquer au même endroit depuis plusieurs jours, au début la boucle ne s'arrêter pas et écrivait des valeurs, maintenant avec les mêmes conditions placées au bon endroit pour que la boucle s'arrête, elle ne fonctionne plus du tout et je n'arrive pas à comprendre d'ou cela vient ; si quelqu'un avait une meilleur vision de la chose et puisse trouver mon erreur qui doit être grossière, ce serait super.

Voilà le code détaillé :

j'imbrique 2 boucles for avec des select case : 1 pour les déignations qui sont du texte dans des listbox, une autre pur les quantités numériques dans des textBox
(il y a trois chapitre identiques, puisque trois plage différentes à renseignées sur la feuille

For i = 11 To 34 'listBox
 For z = 115 To 137 'textbox
        Select Case i 'listBox plage "personnel"
        Case 11 To 16
           Select Case z
           Case 115 To 120 'texBox plage "personnel"

Je récupère le texte de la listBox et le stock dans A et je stock le N° de colonne trouvé plus haut dans le code, dans stcolonne

A = Me("ListBox" & i).Text
            stcolonne = Colonne

Si A est déjà écrit sur la feuille, qu'il est différent de rien et qu'il y a du texte dans la listbox, je cherche la ligne ou A est écrit sur la feuille et je récupère la valeur de la textbox correspondant à la listbox

If Application.CountIf(Range("A39:A45"), "=" & A) <> 0 And A <> "" And Me.Controls("TextBox" & z).Value <> "" Then
                Ligne = Application.Match(A, Columns(1), 0)
               Q = CDbl(Me.Controls("TextBox" & z).Value)

J'incrémente le compteur à zéro avant la boucle et je cherche la ligne qui correspond à la tâche dont je suis entrain d'inscrire les éléments .il y a des 1 inscrits dans les cellules sur la durée ou je dois inscrire les éléments, donc je veux m'en servir comme condition

compteur = 0
                Lig = Range("A36").End(xlUp).Row

Et voici la boucle qui pose problème : normalement tant que les cellules de la ligne "tâche" comporte un 1 et que le compteur n'a pas atteint sa limite, la boucle doit tourner, mais rien ne se passe ?

Do Until Cells(Lig, Colonne) = 1 And compteur <= CDbl(TextBox113.Value)
Cells(Ligne, Colonne).Value = Q 'impossible d'écrire Q dans la cellule
compteur = compteur + 1
Colonne = Colonne + 2 ' je rajoute 2 à la colonne car les cellules sont fusionnées par paire, alors que sur la ligne tâche, elle ne le sont pas ; peu être qu'une partie du problème vient de là ?
Loop[CODE]

Voici la partie du code avec les boucles :

[CODE]Dim stcolonne As Long
 Dim z As Long
Dim Q As Double
Dim A
Dim Lig As Long

 For i = 11 To 34
 For z = 115 To 137
        Select Case i
        Case 11 To 16
           Select Case z
           Case 115 To 120
            A = Me("ListBox" & i).Text
            stcolonne = Colonne
            If Application.CountIf(Range("A39:A45"), "=" & A) <> 0 And A <> "" And Me.Controls("TextBox" & z).Value <> "" Then
                Ligne = Application.Match(A, Columns(1), 0)
               Q = CDbl(Me.Controls("TextBox" & z).Value)
                compteur = 0
                Lig = Range("A36").End(xlUp).Row
                Do Until Cells(Lig, Colonne) = 1 And compteur <= CDbl(TextBox113.Value)
Cells(Ligne, Colonne + 2).Value = Q
compteur = compteur + 1
Colonne = Colonne + 2
Loop
Colonne = stcolonne
                ElseIf Application.CountIf(Range("A39:A45"), "=" & A) = 0 And A <> "" And Me.Controls("TextBox" & z).Value <> "" Then
                Range("A45").End(xlUp).Offset(1, 0) = A
                Ligne = Range("A45").End(xlUp).Row
               Q = CDbl(Me.Controls("TextBox" & z).Value)
                compteur = 0
                Lig = Range("A36").End(xlUp).Row
                Do Until Cells(Lig, Colonne) = 1 And compteur <= CDbl(TextBox113.Value)
Cells(Ligne, Colonne + 2).Value = Q
compteur = compteur + 1
Colonne = Colonne + 2
Loop
            End If

          End Select
          
        Case 17 To 26

           Select Case z
           Case 121 To 129
            A = Me("ListBox" & i).Text
            Colonne = stcolonne
            If Application.CountIf(Range("A87:A128"), "=" & A) <> 0 And A <> "" And A <> "" And Me.Controls("TextBox" & z).Value <> "" Then
                Ligne = Application.Match(A, Columns(1), 0)
               Q = CDbl(Me.Controls("TextBox" & z).Value)
               Q = Q / TextBox113.Value
                compteur = 0
                Lig = Range("A36").End(xlUp).Row
                Do Until Cells(Lig, Colonne) = 1 And compteur <= CDbl(TextBox113.Value)
Cells(Ligne, Colonne + 2).Value = Q
compteur = compteur + 1
Colonne = Colonne + 2
Loop
                ElseIf Application.CountIf(Range("A87:A128"), "=" & A) = 0 And A <> "" And Me.Controls("TextBox" & z).Value <> "" Then
                Range("A128").End(xlUp).Offset(1, 0) = A
                Colonne = stcolonne
                Ligne = Range("A128").End(xlUp).Row
               Q = CDbl(Me.Controls("TextBox" & z).Value)
               Q = Q / TextBox113.Value
                compteur = 0
                Lig = Range("A36").End(xlUp).Row
                Do Until Cells(Lig, Colonne) = 1 And compteur <= CDbl(TextBox113.Value)
Cells(Ligne, Colonne + 2).Value = Q
compteur = compteur + 1
Colonne = Colonne + 2
Loop
            End If
          End Select

                Case 27 To 34
                   Select Case z
           Case 130 To 137
            A = Me("ListBox" & i).Text
            Colonne = stcolonne
              If Application.CountIf(Range("A49:A83"), "=" & A) <> 0 And A <> "" And Me.Controls("TextBox" & z).Value <> "" Then
                Ligne = Application.Match(A, Columns(1), 0)
                Q = CDbl(Me.Controls("TextBox" & z).Value)
                compteur = 0
                Lig = Range("A36").End(xlUp).Row
                Do Until Cells(Lig, Colonne) = 1 And compteur <= CDbl(TextBox113.Value)
Cells(Ligne, Colonne + 2).Value = Q
compteur = compteur + 1
Colonne = Colonne + 2
Loop
                ElseIf Application.CountIf(Range("A49:A83"), "=" & A) = 0 And A <> "" And Me.Controls("TextBox" & z).Value <> "" Then
                Range("A83").End(xlUp).Offset(1, 0) = A
                Colonne = stcolonne
               Ligne = Range("A83").End(xlUp).Row
               Q = CDbl(Me.Controls("TextBox" & z).Value)
               compteur = 0
                Lig = Range("A36").End(xlUp).Row
               Do Until Cells(Lig, Colonne) = 1 And compteur <= CDbl(TextBox113.Value)
Cells(Ligne, Colonne + 2).Value = Q
compteur = compteur + 1
Colonne = Colonne + 2
Loop
            End If
          End Select

        End Select
      
    Next z
   Next i

Merci pour votre aide précieuse

Cordialement

Didier

 

[dmoluc]

Re : Boucle qui ne veut pas s'exécuter ?

A force de tourner la chose sous différent Angles, j'ai réussis à faire fonctionner la boucle, hélas elle ne marche que pour la première liste box, c'est à dire qu'une seule fois et ne tiens pas compte des autres listbox qui s'écrive pourtant bien sur la feuille

While Cells(Lig, Colonne) = 1 And compteur <= CDbl(TextBox113.Value)
Cells(Ligne, Colonne).Value = Q
compteur = compteur + 1
Colonne = Colonne + 2
Wend

comment faire pour que la boucle se répète pour chaque listbox de l'userform ?

Merci pour votre aide