XL 2016 Macro avec LOOP

[xtor]

Bonsoir,

Je ne parviens pas à debuger ce code.
J'ai des titres qui doivent être affichés seulement si les articles sont sélectionnés.

Mon but est de mettre dans la colonne AI si le titre doit apparaitre ou pas
Dans la colonne AJ se trouve les articles.

Mes deux problèmes :
Ma variable doit remonter de bas en haut mais avec la boucle la ligne repasse à la ligne 1 et bloque.
Ma formule ne s'écrit pas correctement ...

D'avance merci et bon week-end
Pouvez-vous m'aider ?

 

[vgendron]

Hello
pas sur d'avoir bien compris le besoin et la formule
un test

Sub Imp2()
Application.ScreenUpdating = False 'on désactive le refresh
With ActiveSheet 'dans la feuille active
    LastLine = .UsedRange.Rows.Count 'on récupère la dernière ligne
    For i = LastLine To 1 Step -1 'en partant de la fin vers la première
        FinZone = i 'pour la fin de range à utlliser dans la formule
        DebZone = .Range("AJ" & i).End(xlUp).Row 'pour le début de range à utiliser dans la formule
        FirstLineFormule = .Range("AJ" & DebZone).End(xlUp).Row + 1 'première ligne où appliquer la formule
        formule = "=iferror(vlookup(""Y"",AJ" & DebZone & ":AJ" & FinZone & ",1,0),""N"")" 'création de la formule
        .Range("AI" & FirstLineFormule).Formula = formule 'affectation de la formule
        If DebZone - FirstLineFormule <= 1 Then 'cas ou la range ne contient qu'une cellule==> la méthode Autofill planterait
       
        Else 'on tire la formule sur toute la range
            .Range("AI" & FirstLineFormule).AutoFill Destination:=.Range("AI" & FirstLineFormule).Resize(DebZone - FirstLineFormule)
        End If
        i = FirstLineFormule - 1 'changemnet d'indice i pour la boucle
    Next i
End With
Application.ScreenUpdating = True
MsgBox "Terminé"
End Sub

 

[fanch55]

Bonsoir,
Testez la macro ci-dessous :

Sub impressionpartielle()
Dim C1 As Range, C2 As Range
Dim Formule As String, Add As String, Target As String
Dim L As Long
    Target = "AH"
    ' Columns(Target).ClearContents
    L = 1
    Set C1 = Columns("AJ").Find("*")
    If Not C1 Is Nothing Then
        Add = C1.Address
        Do
            Set C2 = Columns("AJ").Find("", C1).Offset(-1)
            Formule = "=IFNA(VLOOKUP(""Y""," & C1.Address & ":" & C2.Address & ",1,0),""N"")"
            Range(Cells(L, Target), Cells(C1.Row - 1, Target)).Formula = Formule
            L = C2.Row + 1
            Set C1 = Columns("AJ").Find("*", C2)
        Loop Until C1.Address = Add
    End If
    Set C2 = Nothing
    Set C1 = Nothing
End Sub

Pourquoi 4 lignes de séparation identiques ?

 

[xtor]

Un grand merci ... J'ai pris la fonction de fanch55 qui fonctionne parfaitement ... Je vais pouvoir avancer.

Super !