XL 2010 Gestion d'une condition dans une boucle do while

S

spike29

XLDnaute Occasionnel
Bonsoir,

Débutant en VBA, j'essaye de modifier la valeur d'une variable y / z en fonction de la valeur d'une cellule (celle contenue dans la feuil18(56,mem1)

Toutefois, à chacune de mes tentatives le message d'erreur suivant remonte :

"erreur définie par l'application ou l'objet"

Auriez-vous une solution ?

Extrait du code ci-dessous.

(Le fichier faisant 5Mo avec un code relativement long je vous fais l'économie de vous le transmettre d'autant plus que ).

Le code :

Do While j2 <= Feuil17.Cells(7, 5).Value

' If Feuil18.Cells(56, mem1).Value = "" Then
' y = 64 And z = 55
' Else
' y = 65 And z = 54
' End If

If Feuil18.Cells(y, j2).Value = Feuil18.Cells(z, mem1).Value + Feuil18.Cells(58, mem1).Value Then
Feuil17.Cells(memLigne - 1, 7).Value = Feuil18.Cells(63, j2).Value



If Feuil18.Cells(56, mem1).Value = "" Then GoTo 5

If Feuil18.Cells(56, mem1).Value = "PJV" Then GoTo 6


suite du code .....


J'ai bien déclaré les variables y,z en tant " qu'integer" en début de code.

N'hésitez pas à revenir vers moi si des précisions sont nécessaires.

Merci d'avance pour votre aide et bonne fin de journée

Cordialement
 
Trier par date Trier par votes
Dudu2

Dudu2

XLDnaute Barbatruc
Bonjour,
Déjà le code ce serait plus clair de le mettre dans un format code (bouton </> sur la ligne des styles).
Ensuite ce code est très partiel, par exemple on voit un Do While mais on ne voit pas le Loop qui doit clôturer la boucle. On voit aussi un If sans End If. De plus on ne sait rien des valeurs des variables mem1, memligne. Donc on ne peut pas dire grand chose.
 
Vote positif 0 Vote négatif
S

spike29

XLDnaute Occasionnel
Bonsoir,

Pardon pour la mise en forme, effectivement ça sera mieux avec les boutons </>

Concernant le if sans end if, suivant la synthaxe utilisée le end if n'est pas forcément indispensable. En tout cas j'ai pu l'expérimenter.

Le loop est beaucoup plus bas dans le code et je ne voulais pas "polluer " avec d'autres éléments que ma problématique qui est que la syntaxe VBA semble me refuser le remplacement de chiffre par des variables y,z :

VB: 
If Feuil18.Cells(y, j2).Value = Feuil18.Cells(z, mem1).Value + Feuil18.Cells(58, mem1).Value Then
Feuil17.Cells(memLigne - 1, 7).Value = Feuil18.Cells(63, j2).Value

Quand je remplace y ou z par des chiffres pas de problème ça fonctionne mais ça oblige l'utilisateur à revenir dans le code VBA pour modifier au besoin ces chiffres.
Je souhaite


Pour plus de transparence, mon programme permet de compiler une grille horaires afin de la mettre en forme dans un fichier txt.
Je veux bien te transmettre le fichier car je suis d'accord rien de mieux qu'un support pour cerner la problématique mais il fait 5Mo (si tu as une solution je suis preneur, même en modifiant le format j'excède les 1Mo)

mem1 & mem2 correspond au numéro de colonne d'où va démarrer le code
memLigne correspond au numéro de ligne

De là, la boucle va convertir cette grille horaire en format txt.
Plusieurs sub sont utilisées et se déclenchent de manière séquencées pour arriver au produit finale.

Ci-dessous, celle qui me pose problème au complet.

Le code est très certainement moche, voir très moche (débutant comme je précise), mais il fait le travail et j'arrive comme cela pour l'instant.

J'ai mis en gras la partie du code qui me pose problème.

Merci d'avance pour votre aide.

VB: 
Sub TEST(NbLig, NbCol)


    Dim i1, j1, mem1, i2, i3, i4, i5, i7, i8, i9, j2, y, z, mem2, premiereLigne As Integer
    'Mémoire du numéro de colonne du dernier numéro impair intégré à la grille
    mem1 = NbCol
    'Mémoire du numéro de colonne du  dernier numéro pair intégré à la grille
    mem2 = NbCol
    'Ligne de travail dans la feuille de tracé du fichier N ( feuil fichier N)
    memLigne = NbLig
    'Booléens de test de la fin des numéro de la grille horaire
    Dim finImpair, finPair As Boolean
    finImpair = False
    finPair = False
 
    'Test du premier numéro à partir pour initialiser le système
    If Application.WorksheetFunction.Min(Feuil18.Cells(41, mem1).Value, Feuil18.Cells(65, mem2).Value) = Feuil18.Cells(41, mem1).Value Then
        Feuil17.Cells(memLigne - 3, 1).Value = "SV:T4"
        Feuil17.Cells(memLigne - 2, 7).Value = Feuil18.Cells(40, mem1).Value
        Feuil17.Cells(memLigne - 1, 1).Value = "H:SAS2"
        Feuil17.Cells(memLigne - 2, 6).Value = Feuil18.Cells(37, mem1).Value
        Feuil17.Cells(memLigne - 2, 1).Value = Format(Feuil17.Cells(8, 5).Value)
        Feuil17.Cells(memLigne - 2, 2).Value = "A"
        Feuil17.Cells(memLigne - 2, 5).FormulaR1C1 = "=MID(RC[2],3,2)"
        Feuil17.Cells(memLigne - 2, 4).Value = Feuil17.Cells(11, 5).Value
        Feuil17.Cells(memLigne - 2, 3).Value = Feuil17.Cells(17, 5).Value
        Feuil17.Cells(memLigne - 3, 2).Value = Feuil17.Cells(memLigne - 2, 5)
        Feuil17.Cells(memLigne - 1, 2).NumberFormat = "@"
        Feuil17.Cells(memLigne - 1, 2).Value = Format(Feuil18.Cells(41, mem1).Value - Feuil17.Cells(3, 5).Value, "hhmmss")
        For k = 1 To 5
            Feuil17.Cells(memLigne - 1, 2 + k).Value = Empty
        Next k
     
       If Feuil18.Cells(56, mem1).Value = "" Then GoTo 1

       If Feuil18.Cells(56, mem1).Value = "PJV" Then GoTo 2
     
1
     
       If Feuil18.Cells(37, mem1).Value = "2BA" And Feuil18.Cells(37, mem1).Value = "2BAW" Then GoTo 10
     

        If Feuil18.Cells(37, mem1).Value = "" Then GoTo 12
        If Feuil18.Cells(37, mem1).Value = "W" Then GoTo 12
     
     
     
10
   
   
       For i4 = 0 To 12
   
            If Feuil18.Cells(56, mem1).Value = "" Then
            Feuil17.Cells(memLigne + i4, 1).Value = Feuil18.Cells(43 + i4, 4).Value
            Feuil17.Cells(memLigne + i4, 2).NumberFormat = "@"
            Feuil17.Cells(memLigne + i4, 2).Value = Feuil18.Cells(43 + i4, mem1).Value
            Feuil17.Cells(memLigne + 12, 1).Value = Feuil18.Cells(60, mem1).Value
            End If
         
            If Feuil18.Cells(56, mem1).Value = "" Then
           ' Feuil17.Cells(memLigne + 7, 3).Value = Feuil18.Cells(57, mem1).Value
            Feuil17.Cells(memLigne + 11, 2).Value = Feuil18.Cells(43 + 11, mem1).Value - Feuil18.Cells(57, mem1).Value
            Feuil17.Cells(memLigne + 11, 3).Value = Format(Feuil18.Cells(57, mem1).Value, "hm.ss")
            Feuil17.Cells(memLigne + i4, 2).Value = Format(Feuil17.Cells(memLigne + i4, 2).Value, "hhmmss")
            Feuil17.Cells(memLigne + 11, 2).Value = Format(Feuil17.Cells(memLigne + 11, 2).Value, "hhmmss")
         
            Feuil17.Cells(memLigne - 1, 1).Value = "H:BDY2BA"
            Feuil17.Cells(memLigne - 1, 2).Value = Format(Feuil18.Cells(43, mem1).Value - Feuil17.Cells(7, 7).Value, "hhmmss")
         
            End If
     
            If Feuil18.Cells(57, mem1) = "" Then
            Feuil17.Cells(memLigne + 11, 3) = ""
            End If
 
        Next i4
     
     

     
         If Feuil18.Cells(37, mem1).Value = "" Then
        Feuil17.Cells(memLigne - 2, 6).Value = "0"
        End If
     
        If Feuil18.Cells(37, mem1).Value = "W" Then
        Feuil17.Cells(memLigne - 2, 6).Value = "5"
        End If
     
     
        If Feuil18.Cells(37, mem1).Value = "2BA" Then
        Feuil17.Cells(memLigne - 2, 6).Value = "0"
        End If
         
        If Feuil18.Cells(37, mem1).Value = "2BAW" Then
        Feuil17.Cells(memLigne - 2, 6).Value = "5"
        End If
         

         
            If Feuil17.Cells(memLigne + 14, 1).Value = Feuil17.Cells(17, 6).Value Then
            ThisWorkbook.Worksheets("Fichier N").Cells(memLigne - 2, 3).Value = Feuil17.Cells(17, 5).Value
            Else
            ThisWorkbook.Worksheets("Fichier N").Cells(memLigne - 2, 3).Value = Feuil17.Cells(19, 5).Value
            End If
         
            memLigne = memLigne + 15
            GoTo TestPair
     
     
12


              For i3 = 0 To 14
            If Feuil18.Cells(56, mem1).Value = "" Then
            Feuil17.Cells(memLigne + i3, 1).Value = Feuil18.Cells(41 + i3, 4).Value
            Feuil17.Cells(memLigne + i3, 2).Value = Feuil18.Cells(41 + i3, mem1).Value
            Feuil17.Cells(memLigne + 14, 1).Value = Feuil18.Cells(60, mem1).Value
            End If
         
            If Feuil18.Cells(56, mem1).Value = "" Then
            Feuil17.Cells(memLigne + 13, 3).Value = Feuil18.Cells(57, mem1).Value
             Feuil17.Cells(memLigne + 13, 2).Value = Feuil18.Cells(41 + 13, mem1).Value - Feuil18.Cells(57, mem1).Value

         
            Feuil17.Cells(memLigne + 14, 2).Value = Feuil18.Cells(55, mem1).Value
            Feuil17.Cells(memLigne + 13, 3) = Application.Text(Feuil18.Cells(57, mem1), "[m].ss")
            Feuil17.Cells(memLigne + i3, 2).Value = Format(Feuil17.Cells(memLigne + i3, 2).Value, "hhmmss")
            Feuil17.Cells(memLigne + 13, 2).Value = Format(Feuil17.Cells(memLigne + 13, 2).Value, "hhmmss")

            End If
         
         
            If Feuil18.Cells(57, mem1) = "" Then
            Feuil17.Cells(memLigne + 13, 3) = ""
            End If
         
            Next i3
   
   
        If Feuil18.Cells(37, mem1).Value = "" Then
        Feuil17.Cells(memLigne - 2, 6).Value = "0"
        End If
     
        If Feuil18.Cells(37, mem1).Value = "W" Then
        Feuil17.Cells(memLigne - 2, 6).Value = "5"
        End If
     
     
        If Feuil18.Cells(37, mem1).Value = "2BA" Then
        Feuil17.Cells(memLigne - 2, 6).Value = "0"
        End If
         
        If Feuil18.Cells(37, mem1).Value = "2BAW" Then
        Feuil17.Cells(memLigne - 2, 6).Value = "5"
        End If
         
         
            If Feuil17.Cells(memLigne + 14, 1).Value = Feuil17.Cells(17, 6).Value Then
            ThisWorkbook.Worksheets("Fichier N").Cells(memLigne - 2, 3).Value = Feuil17.Cells(17, 5).Value
            Else
            ThisWorkbook.Worksheets("Fichier N").Cells(memLigne - 2, 3).Value = Feuil17.Cells(19, 5).Value
            End If
         
            memLigne = memLigne + 17
            GoTo TestPair
     
2


  If Feuil18.Cells(37, mem1).Value = "2BA" And Feuil18.Cells(37, mem1).Value = "2BAW" Then GoTo 11
     

        If Feuil18.Cells(37, mem1).Value = "" Then GoTo 13
        If Feuil18.Cells(37, mem1).Value = "W" Then GoTo 13


11





For i2 = 0 To 12
   
            If Feuil18.Cells(56, mem1).Value = "PJV" Then
            Feuil17.Cells(memLigne + i2, 1).Value = Feuil18.Cells(43 + i2, 4).Value
            Feuil17.Cells(memLigne + i2, 2).NumberFormat = "@"
            Feuil17.Cells(memLigne + i2, 2).Value = Feuil18.Cells(43 + i2, mem1).Value
            End If
         
            If Feuil18.Cells(56, mem1).Value = "PJV" Then

            Feuil17.Cells(memLigne + 10, 2).Value = Feuil18.Cells(41 + 12, mem1).Value - Feuil18.Cells(57, mem1).Value

            Feuil17.Cells(memLigne + 10, 3).NumberFormat = "@"
            Feuil17.Cells(memLigne + 10, 3) = Application.Text(Feuil18.Cells(57, mem1), "[m].ss")
            Feuil17.Cells(memLigne + i2, 2).Value = Format(Feuil17.Cells(memLigne + i2, 2).Value, "hhmmss")
            Feuil17.Cells(memLigne + 10, 2).Value = Format(Feuil17.Cells(memLigne + 10, 2).Value, "hhmmss")
         
            Feuil17.Cells(memLigne - 1, 1).Value = "H:BDY2BA"
            Feuil17.Cells(memLigne - 1, 2).Value = Format(Feuil18.Cells(41, mem1).Value - Feuil17.Cells(7, 7).Value, "hhmmss")
         
            End If
     
            If Feuil18.Cells(57, mem1) = "" Then
            Feuil17.Cells(memLigne + 10, 3) = ""
            End If
     
     
 
Next i2


         If Feuil18.Cells(37, mem1).Value = "" Then
        Feuil17.Cells(memLigne - 2, 6).Value = "0"
        End If
     
        If Feuil18.Cells(37, mem1).Value = "W" Then
        Feuil17.Cells(memLigne - 2, 6).Value = "5"
        End If
     
     
        If Feuil18.Cells(37, mem1).Value = "2BA" Then
        Feuil17.Cells(memLigne - 2, 6).Value = "0"
        End If
         
        If Feuil18.Cells(37, mem1).Value = "2BAW" Then
        Feuil17.Cells(memLigne - 2, 6).Value = "5"
        End If
             
             
          Feuil17.Cells(memLigne + 11, 1).Value = Feuil18.Cells(59, mem1).Value
         
            If Feuil17.Cells(memLigne + 13, 1).Value = Feuil17.Cells(17, 13).Value Then
            ThisWorkbook.Worksheets("Fichier N").Cells(memLigne - 2, 3).Value = Feuil17.Cells(11, 10).Value
            Else
            ThisWorkbook.Worksheets("Fichier N").Cells(memLigne - 2, 3).Value = Feuil17.Cells(12, 10).Value
            End If
     
 
        memLigne = memLigne + 14
        GoTo TestPair


13


    For i1 = 0 To 13
 
            If Feuil18.Cells(56, mem1).Value = "PJV" Then
            Feuil17.Cells(memLigne + i1, 1).Value = Feuil18.Cells(41 + i1, 4).Value
            Feuil17.Cells(memLigne + i1, 2).NumberFormat = "@"
            Feuil17.Cells(memLigne + i1, 2).Value = Feuil18.Cells(41 + i1, mem1).Value
            End If
         
            If Feuil18.Cells(56, mem1).Value = "PJV" Then
            Feuil17.Cells(memLigne + 12, 2).Value = Feuil18.Cells(41 + 12, mem1).Value - Feuil18.Cells(57, mem1).Value
            Feuil17.Cells(memLigne + 12, 3).NumberFormat = "@"
            Feuil17.Cells(memLigne + 12, 3) = Application.Text(Feuil18.Cells(57, mem1), "[m].ss")

            Feuil17.Cells(memLigne + i1, 2).Value = Format(Feuil17.Cells(memLigne + i1, 2).Value, "hhmmss")
            Feuil17.Cells(memLigne + 12, 2).Value = Format(Feuil17.Cells(memLigne + 12, 2).Value, "hhmmss")
            End If
     
            If Feuil18.Cells(57, mem1) = "" Then
            Feuil17.Cells(memLigne + 12, 3) = ""
            End If
 
 
        Next i1
     


         If Feuil18.Cells(37, mem1).Value = "" Then
        Feuil17.Cells(memLigne - 2, 6).Value = "0"
        End If
     
        If Feuil18.Cells(37, mem1).Value = "W" Then
        Feuil17.Cells(memLigne - 2, 6).Value = "5"
        End If
     
     
        If Feuil18.Cells(37, mem1).Value = "2BA" Then
        Feuil17.Cells(memLigne - 2, 6).Value = "0"
        End If
         
        If Feuil18.Cells(37, mem1).Value = "2BAW" Then
        Feuil17.Cells(memLigne - 2, 6).Value = "5"
        End If
     
     
     
          Feuil17.Cells(memLigne + 13, 1).Value = Feuil18.Cells(59, mem1).Value
         
            If Feuil17.Cells(memLigne + 13, 1).Value = Feuil17.Cells(17, 13).Value Then
            ThisWorkbook.Worksheets("Fichier N").Cells(memLigne - 2, 3).Value = Feuil17.Cells(17, 12).Value
            Else
            ThisWorkbook.Worksheets("Fichier N").Cells(memLigne - 2, 3).Value = Feuil17.Cells(19, 12).Value
            End If
     
     
        memLigne = memLigne + 16
        GoTo TestPair
     

 
    End If
     
                         
DebutBoucle:
    While Not finImpair Or Not finPair
 
TestImpair:
    If finPair And Not finImpair Then
        finImpair = True
    End If
    j1 = mem1
    On Error GoTo finSVImpair
    Do While j1 <= Feuil17.Cells(6, 5).Value
        If Feuil18.Cells(41, j1).Value = Feuil18.Cells(78, mem2).Value + Feuil18.Cells(80, mem2).Value Then
            Feuil17.Cells(memLigne - 2, 7).Value = Feuil18.Cells(40, j1).Value
            Feuil17.Cells(memLigne - 2, 5).FormulaR1C1 = "=MID(RC[2],3,2)"
            Feuil17.Cells(memLigne - 2, 6).Value = Feuil18.Cells(37, mem2).Value
            Feuil17.Cells(memLigne - 2, 4).Value = Feuil17.Cells(11, 5).Value
            'Feuil17.Cells(memLigne - 2, 3).Value = Feuil17.Cells(17, 5).Value
            Feuil17.Cells(memLigne - 1, 1).Value = "H:SAS2"
            'Feuil17.Cells(memLigne + 10, 1).Value = Feuil18.Cells(17, j1).Value
            Feuil17.Cells(memLigne - 2, 2).Value = "A"
            Feuil17.Cells(memLigne - 1, 2).NumberFormat = "@"
            Feuil17.Cells(memLigne - 1, 2).Value = Format(Feuil18.Cells(41, j1).Value - Feuil17.Cells(3, 5).Value, "hhmmss")
            Feuil17.Cells(memLigne - 2, 1).Value = Format(Feuil17.Cells(8, 5).Value)
            If Feuil18.Cells(41, j1).Value > Feuil17.Cells(5, 5).Value Then
            ThisWorkbook.Worksheets("Fichier N").Cells(memLigne - 2, 4).Value = "O"
            End If
         
         
         
            If Feuil18.Cells(56, j1).Value = "" Then GoTo 3
     
            If Feuil18.Cells(56, j1).Value = "PJV" Then GoTo 4
         
         
3

            For i7 = 0 To 14
            If Feuil18.Cells(56, j1).Value = "" Then
            Feuil17.Cells(memLigne + i7, 1).Value = Feuil18.Cells(41 + i7, 4).Value
            Feuil17.Cells(memLigne + i7, 2).Value = Feuil18.Cells(41 + i7, j1).Value
            Feuil17.Cells(memLigne + 14, 1).Value = Feuil18.Cells(60, j1).Value
            End If
         
            If Feuil18.Cells(56, j1).Value = "" Then
            Feuil17.Cells(memLigne + 13, 3).Value = Feuil18.Cells(57, j1).Value

             Feuil17.Cells(memLigne + 13, 2).Value = Feuil18.Cells(41 + 13, j1).Value - Feuil18.Cells(57, j1).Value

         
            Feuil17.Cells(memLigne + 14, 2).Value = Feuil18.Cells(55, j1).Value
            Feuil17.Cells(memLigne + 13, 3) = Application.Text(Feuil18.Cells(57, j1), "[m].ss")
            Feuil17.Cells(memLigne + i7, 2).Value = Format(Feuil17.Cells(memLigne + i7, 2).Value, "hhmmss")
            Feuil17.Cells(memLigne + 13, 2).Value = Format(Feuil17.Cells(memLigne + 13, 2).Value, "hhmmss")

            End If
         
         
            If Feuil18.Cells(57, j1) = "" Then
            Feuil17.Cells(memLigne + 13, 3) = ""
            End If
         
         
         
            Next i7
         
         
        If Feuil18.Cells(37, j1).Value = "" Then
        Feuil17.Cells(memLigne - 2, 6).Value = "0"
        End If
     
        If Feuil18.Cells(37, j1).Value = "W" Then
        Feuil17.Cells(memLigne - 2, 6).Value = "5"
        End If
           
        If Feuil18.Cells(37, j1).Value = "2BA" Then
        Feuil17.Cells(memLigne - 2, 6).Value = "0"
        End If
         
        If Feuil18.Cells(37, j1).Value = "2BAW" Then
        Feuil17.Cells(memLigne - 2, 6).Value = "5"
        End If
     

         
            If Feuil17.Cells(memLigne + 14, 1).Value = Feuil17.Cells(17, 6).Value Then
            ThisWorkbook.Worksheets("Fichier N").Cells(memLigne - 2, 3).Value = Feuil17.Cells(17, 5).Value
            Else
            ThisWorkbook.Worksheets("Fichier N").Cells(memLigne - 2, 3).Value = Feuil17.Cells(19, 5).Value
            End If
         
        memLigne = memLigne + 16
     
        mem1 = j1
     
         
            Exit Do
        End If
        j1 = j1 + 1
 
    Loop
    If j1 > Feuil17.Cells(6, 5).Value Then
        finImpair = True
    End If
 
    On Error GoTo 0
     

   
     GoTo TestPair
     
     
     
4

       Do While j1 <= Feuil17.Cells(6, 5).Value
   
         For i1 = 0 To 13
            If Feuil18.Cells(56, j1).Value = "PJV" Then
            Feuil17.Cells(memLigne + i1, 1).Value = Feuil18.Cells(41 + i1, 4).Value
            Feuil17.Cells(memLigne + i1, 2).NumberFormat = "@"
            Feuil17.Cells(memLigne + i1, 2).Value = Feuil18.Cells(41 + i1, j1).Value
            Feuil17.Cells(memLigne + 13, 2).Value = Feuil18.Cells(54, j1).Value
            End If
         
            If Feuil18.Cells(56, j1).Value = "PJV" Then
            Feuil17.Cells(memLigne + 12, 2).Value = Feuil18.Cells(41 + 12, j1).Value - Feuil18.Cells(57, j1).Value
            Feuil17.Cells(memLigne + 12, 3).NumberFormat = "@"
            Feuil17.Cells(memLigne + 12, 3) = Application.Text(Feuil18.Cells(57, j1), "[m].ss")
            Feuil17.Cells(memLigne + i1, 2).Value = Format(Feuil17.Cells(memLigne + i1, 2).Value, "hhmmss")
            Feuil17.Cells(memLigne + 12, 2).Value = Format(Feuil17.Cells(memLigne + 12, 2).Value, "hhmmss")
            End If
         
            If Feuil18.Cells(57, j1) = "" Then
            Feuil17.Cells(memLigne + 12, 3) = ""
            End If
     
         
            Next i1
         

         
            If Feuil18.Cells(41, j1).Value > Feuil17.Cells(5, 6).Value Then
            ThisWorkbook.Worksheets("Fichier N").Cells(memLigne - 2, 4).Value = "O"
            End If
         

         
        If Feuil18.Cells(37, j1).Value = "" Then
        Feuil17.Cells(memLigne - 2, 6).Value = "0"
        End If
     
        If Feuil18.Cells(37, j1).Value = "W" Then
        Feuil17.Cells(memLigne - 2, 6).Value = "5"
        End If
           
        If Feuil18.Cells(37, j1).Value = "2BA" Then
        Feuil17.Cells(memLigne - 2, 6).Value = "0"
        End If
         
        If Feuil18.Cells(37, j1).Value = "2BAW" Then
        Feuil17.Cells(memLigne - 2, 6).Value = "5"
        End If
     
         
            Feuil17.Cells(memLigne + 13, 1).Value = Feuil18.Cells(59, j1).Value
         
            If Feuil17.Cells(memLigne + 13, 1).Value = Feuil17.Cells(17, 13).Value Then
            ThisWorkbook.Worksheets("Fichier N").Cells(memLigne - 2, 3).Value = Feuil17.Cells(17, 12).Value
            Else
            ThisWorkbook.Worksheets("Fichier N").Cells(memLigne - 2, 3).Value = Feuil17.Cells(19, 12).Value
            End If
         

         
            mem1 = j1
            memLigne = memLigne + 15
         

             GoTo 7
         
         
         
7

         
         
         
            Exit Do
         

        j1 = j1 + 1
 
    Loop
    If j1 > Feuil17.Cells(6, 5).Value Then
        finImpair = True
    End If
 
    On Error GoTo 0
 
 

TestPair:
    If finImpair And Not finPair Then
        finPair = True
        GoTo DebutBoucle
    End If
    j2 = mem2
    On Error GoTo finSVPair
         
   
      Do While j2 <= Feuil17.Cells(7, 5).Value
           
[B]If Feuil18.Cells(56, mem1).Value = "" Then
y = 64 And z = 55
Else
y = 65 And z = 54
End If[/B]


      [B]  If Feuil18.Cells(y, j2).Value = Feuil18.Cells(z, mem1).Value + Feuil18.Cells(58, mem1).Value Then[/B]
       [B] Feuil17.Cells(memLigne - 1, 7).Value = Feuil18.Cells(63, j2).Value[/B]
     
         
                   
            If Feuil18.Cells(56, mem1).Value = "" Then GoTo 5
     
            If Feuil18.Cells(56, mem1).Value = "PJV" Then GoTo 6
               
5


             For i8 = 0 To 14
                If Feuil18.Cells(56, j2).Value = "" Then
                Feuil17.Cells(memLigne + i8, 1).Value = Feuil18.Cells(64 + i8, 4).Value
                Feuil17.Cells(memLigne + i8, 2).NumberFormat = "@"
                Feuil17.Cells(memLigne + i8, 2).Value = Feuil18.Cells(64 + i8, j2).Value
                Feuil17.Cells(memLigne + 0, 1).Value = Feuil18.Cells(60, j2).Value
                Feuil17.Cells(memLigne + 1, 3) = Application.Text(Feuil18.Cells(86, j2), "[m].ss")
                Feuil17.Cells(memLigne + 0, 2).Value = Format(Feuil18.Cells(64, j2).Value, "hhmmss")
                Feuil17.Cells(memLigne + 1, 2).Value = Feuil18.Cells(65, j2).Value - Feuil18.Cells(86, j2).Value
                Feuil17.Cells(memLigne + i8, 2).Value = Format(Feuil17.Cells(memLigne + i8, 2).Value, "hhmmss")
                Feuil17.Cells(memLigne + 1, 2).Value = Format(Feuil17.Cells(memLigne + 1, 2).Value, "hhmmss")

                If Feuil18.Cells(86, j2) = "" Then
                Feuil17.Cells(memLigne + 1, 3) = ""
                End If
             
             
             
             
                End If
     
            Next i8
         
         
            Feuil17.Cells(memLigne + i8, 1).Value = "H:SAS2"
            Feuil17.Cells(memLigne - 1, 6).Value = Feuil18.Cells(37, j2).Value
            Feuil17.Cells(memLigne - 1, 5).FormulaR1C1 = "=MID(RC[2],3,2)"
            Feuil17.Cells(memLigne - 1, 4).Value = Feuil17.Cells(11, 5).Value

            Feuil17.Cells(memLigne - 1, 2).Value = "R"
            Feuil17.Cells(memLigne - 1, 1).Value = Format(Feuil17.Cells(8, 5).Value)
            Feuil17.Cells(memLigne + i8, 2).NumberFormat = "@"
            Feuil17.Cells(memLigne + i8, 2).Value = Format(Feuil18.Cells(78, j2).Value + Feuil17.Cells(2, 5).Value, "hhmmss")
            If Feuil18.Cells(65, j2).Value > Feuil17.Cells(5, 5).Value Then
                ThisWorkbook.Worksheets("Fichier N").Cells(memLigne - 1, 4).Value = "O"
                End If
             
         
        If Feuil18.Cells(61, j2).Value = "" Then
        Feuil17.Cells(memLigne - 1, 6).Value = "0"
        End If
     
        If Feuil18.Cells(61, j2).Value = "W" Then
        Feuil17.Cells(memLigne - 1, 6).Value = "5"
        End If
       
       
        If Feuil18.Cells(37, j2).Value = "2BA" Then
        Feuil17.Cells(memLigne - 2, 6).Value = "0"
        End If
         
        If Feuil18.Cells(37, j2).Value = "2BAW" Then
        Feuil17.Cells(memLigne - 2, 6).Value = "5"
        End If
         


             If Feuil17.Cells(memLigne + 0, 1).Value = Feuil17.Cells(16, 6).Value Then
            ThisWorkbook.Worksheets("Fichier N").Cells(memLigne - 1, 3).Value = Feuil17.Cells(16, 5).Value
            Else
            ThisWorkbook.Worksheets("Fichier N").Cells(memLigne - 1, 3).Value = Feuil17.Cells(18, 5).Value
            End If
 
            mem2 = j2
            memLigne = memLigne + 18
         
           GoTo 8
       
         
       
6
         
         
          If Feuil18.Cells(61, j2).Value = "2BA" And Feuil18.Cells(61, j2).Value = "2BAW" Then GoTo 20
     
        If Feuil18.Cells(61, j2).Value = "" Then GoTo 21
        If Feuil18.Cells(61, j2).Value = "W" Then GoTo 21
         
         

20


  For i9 = 0 To 13

         


            Feuil17.Cells(memLigne + i9, 1).Value = Feuil18.Cells(65 + i9, 4).Value
            Feuil17.Cells(memLigne + i9, 2).Value = Format(Feuil18.Cells(65 + i9, j2).Value, "hhmmss")
            Feuil17.Cells(memLigne + 12, 1).Value = "H:BDY2BA"
            Feuil17.Cells(memLigne + 12, 2).Value = Format(Feuil18.Cells(76, j2).Value + Feuil17.Cells(7, 7).Value, "hhmmss")


    Next i9
         
         

            Feuil17.Cells(memLigne - 1, 5).FormulaR1C1 = "=MID(RC[2],3,2)"
            Feuil17.Cells(memLigne - 1, 4).Value = Feuil17.Cells(11, 5).Value

            Feuil17.Cells(memLigne - 1, 2).Value = "R"
            Feuil17.Cells(memLigne - 1, 1).Value = Format(Feuil17.Cells(8, 5).Value)
            If Feuil18.Cells(65, j2).Value > Feuil17.Cells(5, 5).Value Then
            ThisWorkbook.Worksheets("Fichier N").Cells(memLigne - 1, 4).Value = "O"
            End If
         
         If Feuil18.Cells(61, j2).Value = "" Then
        Feuil17.Cells(memLigne - 1, 6).Value = "0"
        End If
     
        If Feuil18.Cells(61, j2).Value = "W" Then
        Feuil17.Cells(memLigne - 1, 6).Value = "5"
        End If
       
       
        If Feuil18.Cells(61, j2).Value = "2BA" Then
        Feuil17.Cells(memLigne - 1, 6).Value = "0"
        End If
         
        If Feuil18.Cells(61, j2).Value = "2BAW" Then
        Feuil17.Cells(memLigne - 1, 6).Value = "5"
        End If
         

             If Feuil17.Cells(memLigne + 0, 1).Value = Feuil17.Cells(16, 13).Value Then
            ThisWorkbook.Worksheets("Fichier N").Cells(memLigne - 1, 3).Value = Feuil17.Cells(11, 14).Value
            Else
            ThisWorkbook.Worksheets("Fichier N").Cells(memLigne - 1, 3).Value = Feuil17.Cells(12, 14).Value
            End If
     
     
            mem2 = j2

            memLigne = memLigne + 13
            GoTo 8
         
               
21


            For i2 = 0 To 15

                Feuil17.Cells(memLigne + i2, 1).Value = Feuil18.Cells(65 + i2, 4).Value
                Feuil17.Cells(memLigne + 0, 1).Value = Feuil18.Cells(59, j2).Value

                Feuil17.Cells(memLigne + i2, 2).Value = Feuil18.Cells(65 + i2, j2).Value
                Feuil17.Cells(memLigne + 1, 3).NumberFormat = "@"
                Feuil17.Cells(memLigne + 1, 3) = Application.Text(Feuil18.Cells(86, j2), "[m].ss")

                Feuil17.Cells(memLigne + 0, 2).Value = Format(Feuil18.Cells(65, j2).Value, "hhmmss")
         
                Feuil17.Cells(memLigne + 1, 2).Value = Feuil18.Cells(65 + 1, j2).Value - Feuil18.Cells(86, j2).Value
                Feuil17.Cells(memLigne + i2, 2).Value = Format(Feuil17.Cells(memLigne + i2, 2).Value, "hhmmss")
                Feuil17.Cells(memLigne + 1, 2).Value = Format(Feuil17.Cells(memLigne + 1, 2).Value, "hhmmss")

                If Feuil18.Cells(86, j2) = "" Then
                Feuil17.Cells(memLigne + 1, 3) = ""
                End If
             
            Next i2

            Feuil17.Cells(memLigne + 14, 1).Value = "H:SAS2"

            Feuil17.Cells(memLigne - 1, 6).Value = Feuil18.Cells(61, j2).Value
            Feuil17.Cells(memLigne - 1, 5).FormulaR1C1 = "=MID(RC[2],3,2)"
            Feuil17.Cells(memLigne - 1, 4).Value = Feuil17.Cells(11, 5).Value

            Feuil17.Cells(memLigne - 1, 2).Value = "R"
            Feuil17.Cells(memLigne - 1, 1).Value = Format(Feuil17.Cells(8, 5).Value)
            Feuil17.Cells(memLigne + i2, 2).NumberFormat = "@"
         

            Feuil17.Cells(memLigne + 14, 2).Value = Format(Feuil18.Cells(78, j2).Value + Feuil17.Cells(2, 5).Value, "hhmmss")

 
            If Feuil18.Cells(65, j2).Value > Feuil17.Cells(5, 5).Value Then
            ThisWorkbook.Worksheets("Fichier N").Cells(memLigne - 1, 4).Value = "O"
            End If
         
         
         
         If Feuil18.Cells(61, j2).Value = "" Then
        Feuil17.Cells(memLigne - 1, 6).Value = "0"
        End If
     
        If Feuil18.Cells(61, j2).Value = "W" Then
        Feuil17.Cells(memLigne - 1, 6).Value = "5"
        End If
       
       
        If Feuil18.Cells(61, j2).Value = "2BA" Then
        Feuil17.Cells(memLigne - 1, 6).Value = "0"
        End If
         
        If Feuil18.Cells(61, j2).Value = "2BAW" Then
        Feuil17.Cells(memLigne - 1, 6).Value = "5"
        End If
         

             If Feuil17.Cells(memLigne + 0, 1).Value = Feuil17.Cells(16, 13).Value Then
            ThisWorkbook.Worksheets("Fichier N").Cells(memLigne - 1, 3).Value = Feuil17.Cells(16, 12).Value
            Else
            ThisWorkbook.Worksheets("Fichier N").Cells(memLigne - 1, 3).Value = Feuil17.Cells(18, 12).Value
            End If
     
     
            mem2 = j2
            memLigne = memLigne + 17
           GoTo 8
       
         
         
8

         
            Exit Do
        End If
        j2 = j2 + 1
     
    Loop
    If j2 > Feuil17.Cells(7, 5).Value Then
        finPair = True
    End If
    On Error GoTo 0
 
    Wend
 
    Exit Sub
 
finSVImpair:
    finImpair = True
    On Error GoTo 0
    GoTo TestPair
 
finSVPair:
    finPair = True
    On Error GoTo 0
    GoTo DebutBoucle
 
End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

L
  • Question
VBA : erreur sur boucle
Réponses
2
Affichages
63
Latias
L
petitbuzuc
  • Question
XL 2016 Aide pour maj auto de la date + selection multiple dans une liste déroulante
Réponses
5
Affichages
209
fanch55
fanch55
D
  • Question
XL 2010 suppression de lignes dans un fichier EXCEL via une routine en VBA
Réponses
2
Affichages
240
mapomme
mapomme
F
  • Question
XL 2019 erreur 1004
Réponses
8
Affichages
227
florian50470
F
T
  • Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
888
thivame
T
E
  • Résolu(e)
XL 2019 inserer une valeur textbox dans la dernière cellule vide horizontalement
Réponses
7
Affichages
300
escudo
E
F
  • Question
XL 2016 Comparer 2 tableaux
Réponses
4
Affichages
510
fil28
F
S
  • Question
XL 2019 Problème dans un code vba
Réponses
2
Affichages
408
snoopy07
S
W
  • Question
Microsoft 365 VBA: Supprimer Doublons de data dans une colonne
Réponses
3
Affichages
264
merinos
merinos
Z
  • Question
XL 2021 VBA Prélèvement d'une donnée si une valeur recherchée est identique
Réponses
3
Affichages
177
ZiM
Z

Membres actuellement en ligne

11 membres et 98 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 103
Messages
2 085 316
Membres
102 860
dernier inscrit
fredo67