Code qui ne s'exécute pas jusqu'au bout

Résolu
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   -  
Frenchie83 Messages postés 2240 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,

Mon code (pas du tout optimisé) : 

Sub Macro_TEST()
Dim DL As Long

DL = Range("B65000").End(xlUp).Row


For i = 13 To DL
Compte = CStr(Sheets(1).Range("B" & i).Value)
Compte_1 = CStr(Sheets(1).Range("B" & i - 1).Value)

If Compte = "40301000" Then
    If Compte_1 <> "40301000" Then
        If Compte_1 <> "" Then
            Rows(i & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    End If
End If


If Compte = "40302000" Then
    If Compte_1 <> "40302000" Then
        If Compte_1 <> "" Then
            Rows(i & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    End If
End If


If Compte = "40303000" Then
    If Compte_1 <> "40303000" Then
        If Compte_1 <> "" Then
            Rows(i & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    End If
End If


If Compte = "40304000" Then
    If Compte_1 <> "40304000" Then
        If Compte_1 <> "" Then
            Rows(i & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    End If
End If


If Compte = "40305000" Then
    If Compte_1 <> "40305000" Then
        If Compte_1 <> "" Then
            Rows(i & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    End If
End If


If Compte = "40306000" Then
    If Compte_1 <> "40306000" Then
        If Compte_1 <> "" Then
            Rows(i & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    End If
End If


If Compte = "40307000" Then
    If Compte_1 <> "40307000" Then
        If Compte_1 <> "" Then
            Rows(i & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    End If
End If


If Compte = "40308000" Then
    If Compte_1 <> "40308000" Then
        If Compte_1 <> "" Then
            Rows(i & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    End If
End If


If Compte = "40309000" Then
    If Compte_1 <> "40309000" Then
        If Compte_1 <> "" Then
            Rows(i & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    End If
End If


If Compte = "40310000" Then
    If Compte_1 <> "40310000" Then
        If Compte_1 <> "" Then
            Rows(i & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    End If
End If


If Compte = "40311000" Then
    If Compte_1 <> "40311000" Then
        If Compte_1 <> "" Then
            Rows(i & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    End If
End If


If Compte = "40312000" Then
    If Compte_1 <> "40312000" Then
        If Compte_1 <> "" Then
            Rows(i & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    End If
End If


Next i


End Sub


Allez comprendre, les lignes se créent bien au dessus des 40301000, puis au dessus des 40302000 puis au dessus.... etc par contre arrivé à 40308000, le code n'a pas créé de ligne. Certes, il y a beaucoup plus de 40307000 mais quand même ! Le code devrait aller jusqu'à la fin de la feuille !

Merci d'avance.

Cordialement.
A voir également:

5 réponses

Réponse 1 / 5
Frenchie83 Messages postés 2240 Date d'inscription   Statut Membre Dernière intervention   338
 
Bonjour
Sauf erreur de ma part, le problème c'est que DL est fixé au départ, or il évolue au fur et à mesure qu'on insère des lignes, comme on rajoute 3 lignes à chaque insertion, il faut donc multiplier DL par 3 
Sub Macro_TEST()
    Dim DL As Long
    DL = Range("B65000").End(xlUp).Row
    For i = 13 To DL * 3
        Compte = CStr(Sheets(1).Range("B" & i).Value)
        Compte_1 = CStr(Sheets(1).Range("B" & i - 1).Value)
        If Compte = "40301000" And Compte_1 <> "40301000" And Compte_1 <> "" Then Rows(i & ":" & i + 2).Insert Shift:=xlDown
        If Compte = "40302000" And Compte_1 <> "40302000" And Compte_1 <> "" Then Rows(i & ":" & i + 2).Insert Shift:=xlDown
        If Compte = "40303000" And Compte_1 <> "40303000" And Compte_1 <> "" Then Rows(i & ":" & i + 2).Insert Shift:=xlDown
        If Compte = "40304000" And Compte_1 <> "40304000" And Compte_1 <> "" Then Rows(i & ":" & i + 2).Insert Shift:=xlDown
        If Compte = "40305000" And Compte_1 <> "40305000" And Compte_1 <> "" Then Rows(i & ":" & i + 2).Insert Shift:=xlDown
        If Compte = "40306000" And Compte_1 <> "40306000" And Compte_1 <> "" Then Rows(i & ":" & i + 2).Insert Shift:=xlDown
        If Compte = "40307000" And Compte_1 <> "40307000" And Compte_1 <> "" Then Rows(i & ":" & i + 2).Insert Shift:=xlDown
        If Compte = "40308000" And Compte_1 <> "40308000" And Compte_1 <> "" Then Rows(i & ":" & i + 2).Insert Shift:=xlDown
        If Compte = "40309000" And Compte_1 <> "40309000" And Compte_1 <> "" Then Rows(i & ":" & i + 2).Insert Shift:=xlDown
        If Compte = "40310000" And Compte_1 <> "40310000" And Compte_1 <> "" Then Rows(i & ":" & i + 2).Insert Shift:=xlDown
        If Compte = "40311000" And Compte_1 <> "40311000" And Compte_1 <> "" Then Rows(i & ":" & i + 2).Insert Shift:=xlDown
        If Compte = "40312000" And Compte_1 <> "40312000" And Compte_1 <> "" Then Rows(i & ":" & i + 2).Insert Shift:=xlDown
    Next i
End Sub

A esayer
Cdlt
1
Réponse 2 / 5
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   61
 
D'autant plus que si je relance le code, il continue sur les 40309000 puis s'arrête. Puis je le relance et là il va jusqu'à la fin..

Merci de votre aide.
0
Réponse 3 / 5
ThauTheme Messages postés 1442 Date d'inscription   Statut Membre Dernière intervention   160
 
Bonjour Kuartz, bonjour le forum,

Peut-être on pourrait simplifier le code code ça : 

Sub Macro_TEST()
Dim DL As Long
Dim Compte As String
Dim Compte_1 As String
Dim I As Long
Dim J As Long
Dim K As Long

DL = Range("B65000").End(xlUp).Row
For I = 13 To DL
    Compte = CStr(Sheets(1).Range("B" & I).Value)
    Compte_1 = CStr(Sheets(1).Range("B" & I - 1).Value)
    For J = 1000 To 9000 Step 1000
        If Compte = "4030" & CStr(J) Then
            If Compte <> Compte_1 And Compte_1 <> "" Then
                Rows(I & ":" & I + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            End If
        End If
    Next J
    For K = 10000 To 12000 Step 1000
        If Compte = "403" & CStr(K) Then
            If Compte <> Compte_1 And Compte_1 <> "" Then
                Rows(I & ":" & I + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            End If
        End If
    Next K
Next I
End Sub


Qu'est-ce que ça donne ?

À plus,
ThauTheme
0
Réponse 4 / 5
ThauTheme Messages postés 1442 Date d'inscription   Statut Membre Dernière intervention   160
 
Re,

J'aurais bien mis +10 mais je peux pas...
0
Frenchie83 Messages postés 2240 Date d'inscription   Statut Membre Dernière intervention   338
 
Merci ThauTheme pour l'encouragement, mais notre ami Kuartz n'a visiblement pas lu toutes les réponses, puisque je constate que l'erreur persiste toujours.

Kuartz, j'ai donné une réponse un peu plus haut qui est peut-être la solution à vos problèmes.
Cdlt
0

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

Posez votre question
Réponse 5 / 5
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   61
 
C'est vraiment bizarre ca ne marche pas....

Je vais tenter de vous envoyer le fichier via Cjoint.

Par contre, je vais vous donner le code exact, le problème est que si j'ai un 40301000 ou un 40302000, les actions à réaliser ne sont vraiment pas les mêmes.

Voici mon code final (qui ne marche pas sauf si je le répète plusieurs fois) : 

Sub Macro_TEST()
Dim DL As Long

DL = Range("B65000").End(xlUp).Row


For I = 13 To DL
Compte = CStr(Sheets(1).Range("B" & I).Value)
Compte_1 = CStr(Sheets(1).Range("B" & I - 1).Value)

If Compte = "40301000" Then
    If Compte_1 <> "40301000" Then
        If Compte_1 <> "" Then
            Rows(I & ":" & I + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range(Cells(I + 1, 2), Cells(I + 1, 11)).Merge
            Range("B" & I + 1) = "Effets à payer de Janvier"
            Range("B" & I + 1).Font.Bold = True
            Range("B" & I + 1).HorizontalAlignment = xlCenter
        With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
  End If
End If
End If


If Compte = "40302000" Then
    If Compte_1 <> "40302000" Then
        If Compte_1 <> "" Then
            Rows(I & ":" & I + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range(Cells(I + 1, 2), Cells(I + 1, 11)).Merge
            Range("B" & I + 1) = "Effets à payer de Février"
            Range("B" & I + 1).Font.Bold = True
            Range("B" & I + 1).HorizontalAlignment = xlCenter
    With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        End If
    End If
End If


If Compte = "40303000" Then
    If Compte_1 <> "40303000" Then
        If Compte_1 <> "" Then
            Rows(I & ":" & I + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range(Cells(I + 1, 2), Cells(I + 1, 11)).Merge
            Range("B" & I + 1) = "Effets à payer de Mars"
            Range("B" & I + 1).Font.Bold = True
            Range("B" & I + 1).HorizontalAlignment = xlCenter
         With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        End If
    End If
End If


If Compte = "40304000" Then
    If Compte_1 <> "40304000" Then
        If Compte_1 <> "" Then
            Rows(I & ":" & I + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range(Cells(I + 1, 2), Cells(I + 1, 11)).Merge
            Range("B" & I + 1) = "Effets à payer d'Avril"
            Range("B" & I + 1).Font.Bold = True
            Range("B" & I + 1).HorizontalAlignment = xlCenter
           With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        End If
    End If
End If


If Compte = "40305000" Then
    If Compte_1 <> "40305000" Then
        If Compte_1 <> "" Then
            Rows(I & ":" & I + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range(Cells(I + 1, 2), Cells(I + 1, 11)).Merge
            Range("B" & I + 1) = "Effets à payer de Mai"
            Range("B" & I + 1).Font.Bold = True
            Range("B" & I + 1).HorizontalAlignment = xlCenter
         With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        End If
    End If
End If


If Compte = "40306000" Then
    If Compte_1 <> "40306000" Then
        If Compte_1 <> "" Then
            Rows(I & ":" & I + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range(Cells(I + 1, 2), Cells(I + 1, 11)).Merge
            Range("B" & I + 1) = "Effets à payer de Juin"
            Range("B" & I + 1).Font.Bold = True
            Range("B" & I + 1).HorizontalAlignment = xlCenter
        With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        End If
    End If
End If


If Compte = "40307000" Then
    If Compte_1 <> "40307000" Then
        If Compte_1 <> "" Then
            Rows(I & ":" & I + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range(Cells(I + 1, 2), Cells(I + 1, 11)).Merge
            Range("B" & I + 1) = "Effets à payer de Juillet"
            Range("B" & I + 1).Font.Bold = True
            Range("B" & I + 1).HorizontalAlignment = xlCenter
            With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        End If
    End If
End If


If Compte = "40308000" Then
    If Compte_1 <> "40308000" Then
        If Compte_1 <> "" Then
            Rows(I & ":" & I + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range(Cells(I + 1, 2), Cells(I + 1, 11)).Merge
            Range("B" & I + 1) = "Effets à payer de Août"
            Range("B" & I + 1).Font.Bold = True
            Range("B" & I + 1).HorizontalAlignment = xlCenter
         With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        End If
    End If
End If


If Compte = "40309000" Then
    If Compte_1 <> "40309000" Then
        If Compte_1 <> "" Then
            Rows(I & ":" & I + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range(Cells(I + 1, 2), Cells(I + 1, 11)).Merge
            Range("B" & I + 1) = "Effets à payer de Septembre"
            Range("B" & I + 1).Font.Bold = True
            Range("B" & I + 1).HorizontalAlignment = xlCenter
          With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        End If
    End If
End If


If Compte = "40310000" Then
    If Compte_1 <> "40310000" Then
        If Compte_1 <> "" Then
            Rows(I & ":" & I + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range(Cells(I + 1, 2), Cells(I + 1, 11)).Merge
            Range("B" & I + 1) = "Effets à payer de Octobre"
            Range("B" & I + 1).Font.Bold = True
            Range("B" & I + 1).HorizontalAlignment = xlCenter
          With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        End If
    End If
End If


If Compte = "40311000" Then
    If Compte_1 <> "40311000" Then
        If Compte_1 <> "" Then
            Rows(I & ":" & I + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range(Cells(I + 1, 2), Cells(I + 1, 11)).Merge
            Range("B" & I + 1) = "Effets à payer de Novembre"
            Range("B" & I + 1).Font.Bold = True
            Range("B" & I + 1).HorizontalAlignment = xlCenter
            With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        End If
    End If
End If


If Compte = "40312000" Then
    If Compte_1 <> "40312000" Then
        If Compte_1 <> "" Then
            Rows(I & ":" & I + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range(Cells(I + 1, 2), Cells(I + 1, 11)).Merge
            Range("B" & I + 1) = "Effets à payer de Décembre"
            Range("B" & I + 1).Font.Bold = True
            Range("B" & I + 1).HorizontalAlignment = xlCenter
            With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        With Range(Cells(I + 1, 2), Cells(I + 1, 11)).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        End If
    End If
End If

Next I

End Sub


Pardon pour la longueur....
0
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   61
 
Fichier anonymé : https://www.cjoint.com/c/EGipcAG1WQf

Votre macro est en module 4, la mienne en module 5.

Vous allez constater le problème.

Edit : Le code pour accéder au VBA : Fretjerome
0
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   61
 
A la limite, je pourrais presque ré-éxécuter le code plusieurs fois à la chaîne étant donné qu'il faut répéter la macro plusieurs fois pour le code ailler jusqu'au bout mais bon.... C'est un peu ridicule...
0
Frenchie83 Messages postés 2240 Date d'inscription   Statut Membre Dernière intervention   338
 
Avez-vous appliquez ce que je vous ai de faire? voir post 6 et 3
Sur votre fichier, l'accés à vos macros est verrouillé
0
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   61 > Frenchie83 Messages postés 2240 Date d'inscription   Statut Membre Dernière intervention  
 
Je teste immédiatement. (Pardon de ne pas avoir vu votre réponse, je ne comprend pas pourquoi je les vois aussi tardivement à chaque fois...)
0
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   61
 
Ca marche parfaitement, bravo vraiment. Et merci d'avoir répondu aussi vite.

Merci encore.
0

Discussions similaires

Comment enlever le chiffrement de bout en bout sur messenger
abfouz -
Radinoz -

3 réponses
sertissage des cables rj45
lekludo -
brupala -

7 réponses
Messenger chiffrement de bout en bout.
ghis2000 -
Titia -

2 réponses