XL 2019 Aide modification vba

[Fanrs]

Bonjour,

J'ai ce code vba (ci-dessous) qui marche très bien pour supprimer les lignes en doubles dont les cellules, jusqu'à la colonne 15, sont identiques.

Malheureusement, cela marche sur un tableau commençant à la ligne 1 jusqu'a la fin, mais pas sur un tableau commençant à la ligne 7... Est-ce que quelqu'un peut me le modifier pour qu'il soit fonctionnement de la ligne 7 jusqu'a la fin ?

Dim i As Long, LigFin As Long
Dim j As Integer
Const NbCol = 5     'Nombre de colonnes
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
With Sheets("Feuil1")                   'A adapter
    .Rows(1).Insert
    For j = 1 To NbCol
        .Cells(1, j) = Chr(65 + j)
    Next j
    LigFin = .Cells(Rows.Count, 1).End(xlUp).Row
        If .FilterMode Then .ShowAllData
            .Range(.Cells(1, 1), .Cells(LigFin, NbCol)).AdvancedFilter xlFilterInPlace, , , True
            For i = LigFin To 2 Step -1
                If .Rows(i).Hidden And Application.CountBlank(.Range(.Cells(i, 1), .Cells(i, NbCol))) <> NbCol Then .Rows(i).Delete
            Next i
         If .FilterMode Then .ShowAllData
    .Rows(1).Delete
End With
Application.DisplayAlerts = True

Et à côté de ça, est-il possible au lieu de supprimer les lignes en doubles de les masquer ?

Merci d'avance

 

[JBARBE]

Bonjour à tous,
Peut-être ceci :
Bonne journée !

Dim i As Long, LigFin As Long
Dim j As Integer
Const NbCol = 5     'Nombre de colonnes
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
With Sheets("Feuil1")                   'A adapter
    .Rows(1).Insert
    For j = 7 To NbCol
        .Cells(1, j) = Chr(65 + j)
    Next j
    LigFin = .Cells(Rows.Count, 1).End(xlUp).Row
        If .FilterMode Then .ShowAllData
            .Range(.Cells(1, 1), .Cells(LigFin, NbCol)).AdvancedFilter xlFilterInPlace, , , True
            For i = LigFin To 2 Step -1
                If .Rows(i).Hidden And Application.CountBlank(.Range(.Cells(i, 1), .Cells(i, NbCol))) <> NbCol Then .Rows(i).Delete
            Next i
         If .FilterMode Then .ShowAllData
    .Rows("1:1").EntireRow.Hidden = True
End With
Application.DisplayAlerts = True

 

[Fanrs]

Merci pour ta réponse et proposition, mais malheureusement ça me fait des trucs bizarre sur la première ligne et aucune suppression de doublon

 

[Bernard_XLD]

Bonjour Fanrs, JBARBE, le forum

en faisant simple, cela devrait fonctionner

Cordialement, @+

Dim i As Long, LigFin As Long
Dim j As Integer
Const NbCol = 5     'Nombre de colonnes
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
With Sheets("Feuil1")                   'A adapter
    .Rows(7).Insert
    For j =1 To NbCol
        .Cells(7, j) = Chr(65 + j)
    Next j
    LigFin = .Cells(Rows.Count, 1).End(xlUp).Row
        If .FilterMode Then .ShowAllData
            .Range(.Cells(7, 1), .Cells(LigFin, NbCol)).AdvancedFilter xlFilterInPlace, , , True
            For i = LigFin To 8 Step -1
                If .Rows(i).Hidden And Application.CountBlank(.Range(.Cells(i, 1), .Cells(i, NbCol))) <> NbCol Then .Rows(i).Delete
            Next i
         If .FilterMode Then .ShowAllData
    .Rows(7).Delete
End With
Application.DisplayAlerts = True

 

[Bernard_XLD]

Et à côté de ça, est-il possible au lieu de supprimer les lignes en doubles de les masquer ?

je n'avais pas vu ta dernière demande
pas testé faute de fichier mais ça devrait fonctionner

[édition: code modifié]
Bien cordialement

Dim i As Long, LigFin As Long
Dim j As Integer, Cells_Masque As Range
Const NbCol = 5     'Nombre de colonnes
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Sheets("Feuil1")                   'A adapter
    .Rows(7).Insert
    For j = 1 To NbCol
        .Cells(7, j) = Chr(65 + j)
    Next j
    LigFin = .Cells(.Rows.Count, 1).End(xlUp).Row
        If .FilterMode Then .ShowAllData
            .Range(.Cells(7, 1), .Cells(LigFin, NbCol)).AdvancedFilter xlFilterInPlace, , , True
            For i = LigFin To 8 Step -1
                If .Rows(i).Hidden And Application.CountBlank(.Range(.Cells(i, 1), .Cells(i, NbCol))) <> NbCol Then '.Rows(i).Delete
                    If Cells_Masque Is Nothing Then
                        Set Cells_Masque = .Range("A" & i)
                    Else
                        Set Cells_Masque = Application.Union(Cells_Masque, .Range("A" & i))
                    End If
                End If
            Next i
         If .FilterMode Then .ShowAllData
    If Not Cells_Masque Is Nothing Then Cells_Masque.EntireRow.Hidden = True: Set Cells_Masque = Nothing
    .Rows(7).Delete
End With
Application.DisplayAlerts = True

 

[Fanrs]

Merci pour ton aide,

Pour supprimer les lignes ça à l'air d'être ok
Pour masquer les lignes j'ai une erreur Cells_Masque.EntireRow.Delete Shift:=xlUp

 

[Bernard_XLD]

re essayes, j'ai modifié le dernier code
sinon mets un fichier exemple

 

[Bernard_XLD]

sinon essayes aussi comme cela

Dim i As Long, LigFin As Long
Dim j As Integer, Cells_Masque As Range, Cel_en_Cours As Range
Const NbCol = 5     'Nombre de colonnes
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Sheets("Feuil1")                   'A adapter
    .Rows(7).Insert
    For j = 1 To NbCol
        .Cells(7, j) = Chr(65 + j)
    Next j
    LigFin = .Cells(Rows.Count, 1).End(xlUp).Row
    If .FilterMode Then .ShowAllData
    .Range(.Cells(7, 1), .Cells(LigFin, NbCol)).AdvancedFilter xlFilterInPlace, , , True
    For i = LigFin To 8 Step -1
        If .Rows(i).Hidden And Application.CountBlank(.Range(.Cells(i, 1), .Cells(i, NbCol))) <> NbCol Then '.Rows(i).Delete
            If Cells_Masque Is Nothing Then
                Set Cells_Masque = .Range("A" & i)
            Else
                Set Cells_Masque = Application.Union(Cells_Masque, .Range("A" & i))
            End If
        End If
    Next i
    If .FilterMode Then .ShowAllData
    If Not Cells_Masque Is Nothing Then
        For Each Cel_en_Cours In Cells_Masque
            Cel_en_Cours.EntireRow.Hidden = True
        Next Cel_en_Cours
        Set Cells_Masque = Nothing
    End If
    .Rows(7).Delete
End With
Application.DisplayAlerts = True

 

[Fanrs]

Parfait, merci !

 

[Bernard_XLD]

Si tu rencontres d'autres problèmes, essayes de faire un fichier exemple simple et anonymisé, c'est beaucoup plus facile pour les contributeurs quand on peut tester qu'avec juste un code.

Bonne continuation, @+

 

[Fanrs]

Si tu rencontres d'autres problèmes, essayes de faire un fichier exemple simple et anonymisé, c'est beaucoup plus facile pour les contributeurs quand on peut tester qu'avec juste un code.

Bonne continuation, @+

Merci pour le conseil, mais surtout pour l'aide.... c'est grâce à des gens comme vous que l'on peut avancer et peut être un jour, je retournerai pour d'autre personnes...

Chaque aide est peut-être la création d'une chaine d'aide 😇

Merci