Aide sur les boucles

Didier972 · 29 Août 2011

Bonjour
Voilà, j'ai un code qui fonctionne, mais j'aimerais l'allèger, en faisant une boucle, et c'et là que pour moi cela se complique....lol
donc voici le code qui fonctionne

Code:

Private Sub CB_Valider2_Click()
Nom = Lab_Nom
If Nom = "" Then
MsgBox "Veuillez selectionner un Nom dans la Liste."
'Else
'Exit Sub
End If
If TB_Nbre1 = "" Then
Else
P1 = TB_Nbre1 * Lab_Prix1
End If
    If TB_Nbre2 = "" Then
    Else
    P2 = TB_Nbre2 * Lab_Prix2
    End If
        If TB_Nbre3 = "" Then
        Else
        P3 = TB_Nbre3 * Lab_Prix3
        End If
            If TB_Nbre4 = "" Then
            Else
            P4 = TB_Nbre4 * Lab_Prix4
            End If
If TB_Nbre5 = "" Then
Else
P5 = TB_Nbre5 * Lab_Prix5
End If
    If TB_Nbre6 = "" Then
    Else
    P6 = TB_Nbre6 * Lab_Prix6
    End If
        If TB_Nbre7 = "" Then
        Else
        P7 = TB_Nbre7 * Lab_Prix7
        End If
            If TB_Nbre8 = "" Then
            Else
            P8 = TB_Nbre8 * Lab_Prix8
            End If
Lab_Total = P1 + P2 + P3 + P4 + P5 + P6 + P7 + P8

voilà, ce ci est la partie ou je voudrais appliquer une boucle.

et voilà, ce que j'essaie de faire mais qui ne fonctionne pas

Code:

Dim I2 as Variant
           Dim J2 as Variant
           Dim K2 as Variant
          
            I2 = TB_Nbre(I)
               J2 = Lab_Prix(J)
                    K2 = P(K)

For I = 1 To 8
    For J = 1 To 8
        For K = 1 To 8
  
If I2 = "" Then
Else
K2 = I2 * J2
    Next K
        Next J
            Next I

voilà, si quelqu'un a une idée, même me donner la route afin que je comprenne mon erreur ou à moins ce que j'ai fait soit vraiment à coté de la plaque....lol, merci

Pierrot93 · 29 Août 2011

Re : Aide sur les boucles

Bonjour,

ce code est sensé faire quoi ? en l'état pas facile de t'aider... soit un peu plus d'exxplication, ou mieux un petit fichier avec données de départ et résultat attendu..

bon après midi
@+

Etienne2323 · 29 Août 2011

Re : Aide sur les boucles

Salut Didier,
voici une possibilité avec des variables tablo :

VB:

Option Explicit

Private Sub CB_Valider2_Click()

Dim Tb_Nbre(1 To 8) As Single, Lab_Prix(1 To 8) As Single, P(1 To 8) As Single
Dim Lab_Total As Single
Dim i As Byte
Dim Nom As String

Application.ScreenUpdating = False

Nom = Lab_Nom

If Nom = "" Then MsgBox "Veuillez selectionner un Nom dans la Liste."
Lab_Total  = 0
For i = 1 To 8
    If Tb_Nbre(i) <> "" Then
        P(i) = Tb_Nbre(i) * Lab_Prix(i)
        Lab_Total = Lab_Total + P(i)
    End If
Next i

Erase Tb_Nbre, Lab_Prix, P

End Sub

Cordialement,

Étienne

Didier972 · 29 Août 2011

Re : Aide sur les boucles

Merci pour ton aide, mais là mon code s'e bloque au niveau du C, j'ai bien essayer de le déclarer mais cela ne change rien.

VB:

 Private Sub CB_Valider2_Click()
 
 Dim Tb_Nbre(1 To 8) As Single, Lab_Prix(1 To 8) As Single, P(1 To 8) As Single
 Dim Lab_Total As Single
 Dim i As Byte
 Dim Nom As String
 
Application.ScreenUpdating = False
 
Nom = Lab_Nom
 
If Nom = "" Then MsgBox "Veuillez selectionner un Nom dans la Liste."
 Lab_Total = 0
 For i = 1 To 8
     If Tb_Nbre(i) <> "" Then
         P(i) = Tb_Nbre(i) * Lab_Prix(i)
         Lab_Total = Lab_Total + P(i)
     End If
 Next i
 
Erase Tb_Nbre, Lab_Prix, P
 
Lab_Total = P1 + P2 + P3 + P4 + P5 + P6 + P7 + P8

   
        With Sheets("Conso")
            'Chercher son nom dans la feuille Conso colonne A
            Set C = .Range("A5:A" & .Cells(.Rows.Count, 1).End(xlUp).Row).Find( _
                            What:=Nom, _
                            After:=.Range("A5"), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            
            'Son nom n'a pas été trouvé, la cellule sera la prochaine libre en bas de colonne
            If C Is Nothing Then Set C = .Range("A" & .Cells(.Rows.Count, 1).End(xlUp).Row)(2)
            
            'y mettre le nom
            C.Value = Nom
            
            'et la somme deux colonnes à droite
            If C(1, 2).Value = "" Then C(1, 2) = CDec(Lab_Total) Else C(1, 2) = C(1, 2) + CDec(Lab_Total)
            ' Note la date
            C(1, 3).Value = Date
    End With
'Si La case Carte est superieur à zero
'Ajouter le client en fin de colonne b
If TB_Nbre1 = "" Then
Else
'Rajoute une carte supp au client
'Nom = LB_reglement
Worksheets("Client").Activate
Columns(1).Find(Nom, , , , , Previous).Select
ActiveCell.Offset(0, 1) = ActiveCell.Offset(0, 1).Value + 1

    Set C = Sheets("Carte").Range("B" & Rows.Count).End(xlUp)(2)
    C.Value = Nom
    
    'Demande s'il a payé sa carte
    If MsgBox("A t'il réglé sa carte ?", vbYesNo, "Règlement de la Carte Boisson.") = vbYes Then
        'Oui on inscrit x à côté
        C(1, 2) = "X"
    'Else
   
    End If
    End If
Lab_Total.Caption = ClearContents
TB_Nbre1 = ClearContents
TB_Nbre2 = ClearContents
TB_Nbre3 = ClearContents
TB_Nbre4 = ClearContents
TB_Nbre5 = ClearContents
TB_Nbre6 = ClearContents
TB_Nbre7 = ClearContents
TB_Nbre8 = ClearContents
Lab_Nom = ClearContents
Lab_Nom.Visible = False
End Sub

Cordialement

Etienne2323 · 29 Août 2011

Re : Aide sur les boucles

Salut Didier,
sans fichier pour tester, difficile de voir si la modification est juste. Par contre, je crois que cela devrait fonctionner.

À noter que la variable Lab_Total se calcule maintenant dans la boucle, et non plus via la somme.

VB:

Option Explicit

Private Sub CB_Valider2_Click()
 
 Dim Tb_Nbre(1 To 8) As Single, Lab_Prix(1 To 8) As Single, P(1 To 8) As Single
 Dim Lab_Total As Single
 Dim i As Byte
 Dim Nom As String
 Dim DL As Long, Ligne_Inscription as Long
 Dim c
 
Application.ScreenUpdating = False
 
Nom = Lab_Nom
 
If Nom = "" Then MsgBox "Veuillez selectionner un Nom dans la Liste."
 Lab_Total = 0
 For i = 1 To 8
     If Tb_Nbre(i) <> "" Then
         P(i) = Tb_Nbre(i) * Lab_Prix(i)
         Lab_Total = Lab_Total + P(i)
     End If
 Next i
 
   
Sheets("Conso").Select
DL = Cells(65536, 1).End(xlUp).Row
Set c = Range("A5:A" & DL).Find(What:=Nom, LookIn:=xlValues, LookAt:=xlWhole)
If c Is Nothing Then
    Ligne_Inscription = DL + 1
Else
    Ligne_Inscription = c.Row
End If

Cells(Ligne_Inscription, 1).Value = Nom

'La somme deux colonnes à droite
If Cells(Ligne_Inscription, 2).Value = "" Then
    Cells(Ligne_Inscription, 2).Value = CDec(Lab_Total)
Else
    Cells(Ligne_Inscription, 2).Value = Cells(Ligne_Inscription, 2).Value + CDec(Lab_Total)
End If


'Note la date
Cells(Ligne_Inscription, 3).Value = Date

'Si La case Carte est superieur à zero
'Ajouter le client en fin de colonne b
If Tb_Nbre(1) <> "" Then
'Rajoute une carte supp au client
    'Nom = LB_reglement
    Worksheets("Client").Activate
    Columns(1).Find(Nom, , , , , Previous).Select
    ActiveCell.Offset(0, 1) = ActiveCell.Offset(0, 1).Value + 1

    Set c = Sheets("Carte").Range("B" & Rows.Count).End(xlUp)(2)
    c.Value = Nom
    
    'Demande s'il a payé sa carte
    If MsgBox("A t'il réglé sa carte ?", vbYesNo, "Règlement de la Carte Boisson.") = vbYes Then Cells(c.Row, 2).Value = "X"
End If

With Lab_Total
    .Caption = ""
    .Visible = False
End With

Erase Tb_Nbre, Lab_Prix, P

End Sub

Cordialement,

Étienne

Aide sur les boucles

Didier972

XLDnaute Junior

Pierrot93

XLDnaute Barbatruc

Etienne2323

XLDnaute Impliqué

Didier972

XLDnaute Junior

Etienne2323

XLDnaute Impliqué

Discussions similaires

Aide sur les boucles

Didier972

XLDnaute Junior

Pierrot93

XLDnaute Barbatruc

Etienne2323

XLDnaute Impliqué

Didier972

XLDnaute Junior

Etienne2323

XLDnaute Impliqué

Discussions similaires

Privacy & Transparency

Privacy & Transparency