Pb de macro qui tourne en boucle...

[klm1234]

Bonjour le forum!

Voilà je me fait une petite macro toute bête qui pourtant me cause bien des problèmes. Le but est simple : supprimer des cellules vides.

Je cherche à déclencher cette macro lorsqu'une modification est apportée à la feuille. En fait cette feuille est une liste de choix sur plusieurs colonnes qui est utilisée dans une liste en validation sur une autre feuille. Le problème c'est que la macro tourne en boucle continuellement sans jamais s'arrêter.

Voici mon code :

Option Explicit
Private Sub Worksheet_Change(ByVal Target As range)
    
    Dim rPl As range
    Dim i As Long, x As Long
    Dim sColL$

        For i = Int(Log(CDbl(25 * (CDbl(Target.Column) + 1))) / Log(26)) - 1 To 0 Step -1
        x = (26 ^ (i + 1) - 1) / 25 - 1
            If Target.Column > x Then
                sColL = sColL & Chr(((Target.Column - x - 1) \ 26 ^ i) Mod 26 + 65)
            End If
        Next i
    Set rPl = range(sColL & "2:" & sColL & "65536") 
        For Each cel In rPl
            If cel.Value = "" Then
                If cel.Offset(1, 0) = "" Then cel.Delete (xlShiftUp)
            Else Exit Sub
            End If
        Next
    cel = Empty
End Sub

Je soupçonne plusieurs problèmes, à mon avis je ne m'y prend pas du tout de la bonne manière. La plage "rPl" est douteuse... Étant donné que "Target.Column" ne renvoie pas la lettre mais le numéro de la colonne j'ai du faire une macro qui transforme ce chiffre en colonne. Je stock cette lettre dans la variable sColL qui elle me sert à construire la plage rPl. Cette plage est tout simplement la colonne entière, moins l'en-tête (ie : "F2:F65536").

Deuxio, si mon code marche, le tout plante puisqu'en supprimant la cellule vide, cela re-déclenche le lancement de la macro, etc.

Merci tout le monde!
J'ai mis de petites explications dans le fichiers pour les visuels

 

[Guest]

Re : Pb de macro qui tourne en boucle...

Bonjour klm1234,

Si j'ai bien compris, cela devrait le faire

[COLOR=BLUE]Private[/COLOR] [COLOR=BLUE]Sub[/COLOR] Worksheet_Change([COLOR=BLUE]ByVal[/COLOR] Target [COLOR=BLUE]As[/COLOR] Range)
    [COLOR=BLUE]Dim[/COLOR] plg [COLOR=BLUE]As[/COLOR] Range
    
    [COLOR=GREEN]'Retourne l'intersection de la plage utilisée et de la colonne de Target[/COLOR]
    [COLOR=GREEN]'pour en garder que les cellules vides[/COLOR]
    
    [COLOR=BLUE]Set[/COLOR] plg = Intersect(UsedRange, Columns(Target.Column)).SpecialCells(xlCellTypeBlanks)
    
    [COLOR=BLUE]If[/COLOR] [COLOR=BLUE]Not[/COLOR] plg [COLOR=BLUE]Is[/COLOR] [COLOR=BLUE]Nothing[/COLOR] [COLOR=BLUE]Then[/COLOR]
        [COLOR=GREEN]'Permet d'empecher les appels en boucle[/COLOR]
        Application.EnableEvents = [COLOR=BLUE]False[/COLOR]
        plg.Delete xlShiftUp
        [COLOR=GREEN]'Rétablir la gestion des évènements[/COLOR]
        Application.EnableEvents = [COLOR=BLUE]True[/COLOR]
    [COLOR=BLUE]End[/COLOR] [COLOR=BLUE]If[/COLOR]
[COLOR=BLUE]End[/COLOR] [COLOR=BLUE]Sub[/COLOR]

A+

 

[klm1234]

Re : Pb de macro qui tourne en boucle...

Bonjour Hasco,

Effectivement ta macro marche! Enfin presque... Lorsque que je rajoute un champ il me fait une erreur : "No cells were found".

Ce qui est logique puisqu'aucune "Blank Cell" n'est introduite... Un petit If devrait régler le problème, mais comment dire "Si on a pas supprimé de celulle..."

Merci beaucoup!

 

[Guest]

Re : Pb de macro qui tourne en boucle...

Re,

Oui SpecialCells lève une errur si aucune cellule correspondante n'est trouvée.

Macro modifiée.

[COLOR=BLUE]Private[/COLOR] [COLOR=BLUE]Sub[/COLOR] Worksheet_Change([COLOR=BLUE]ByVal[/COLOR] Target [COLOR=BLUE]As[/COLOR] Range)
    [COLOR=BLUE]Dim[/COLOR] plg [COLOR=BLUE]As[/COLOR] Range
    
    [COLOR=GREEN]'Retourne l'intersection de la plage utilisée et de la colonne de Target[/COLOR]
    [COLOR=GREEN]'pour en garder que les cellules vides[/COLOR]
    [COLOR=BLUE]On[/COLOR] [COLOR=BLUE]Error[/COLOR] [COLOR=BLUE]Resume[/COLOR] [COLOR=BLUE]Next[/COLOR]
    [COLOR=BLUE]Set[/COLOR] plg = Intersect(UsedRange, Columns(Target.Column)).SpecialCells(xlCellTypeBlanks)
    [COLOR=BLUE]If[/COLOR] [COLOR=BLUE]Not[/COLOR] plg [COLOR=BLUE]Is[/COLOR] [COLOR=BLUE]Nothing[/COLOR] [COLOR=BLUE]Then[/COLOR]
        [COLOR=GREEN]'Permet d'empecher les appels en boucle[/COLOR]
        Application.EnableEvents = [COLOR=BLUE]False[/COLOR]
        plg.Delete xlShiftUp
        [COLOR=GREEN]'Rétablir la gestion des évènements[/COLOR]
        Application.EnableEvents = [COLOR=BLUE]True[/COLOR]
    [COLOR=BLUE]End[/COLOR] [COLOR=BLUE]If[/COLOR]
    Err.Clear
[COLOR=BLUE]End[/COLOR] [COLOR=BLUE]Sub[/COLOR]

A+

 

[klm1234]

Re : Pb de macro qui tourne en boucle...

Re,

Magnifique sa marche impec! Merci beaucoup

Cordialement,
Klm1234