XL 2019 Aide modification vba

Fanrs

XLDnaute Nouveau
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 ?

VB:
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
 
Solution
sinon essayes aussi comme cela
VB:
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...

JBARBE

XLDnaute Barbatruc
Bonjour à tous,
Peut-être ceci :
Bonne journée !
VB:
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
 
Bonjour Fanrs, JBARBE, le forum

en faisant simple, cela devrait fonctionner

Cordialement, @+
VB:
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
 
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
Code:
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
 
Dernière édition:
sinon essayes aussi comme cela
VB:
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

XLDnaute Nouveau
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
 

Discussions similaires

Réponses
5
Affichages
202