Suppression ligne

[cloclo57]

Bonjour le Forum

J'ai récuperé sur le forum une partie de programme en VBA
me supprimant la ligne doublon si toutes les cellules de cette ligne sont identique a une autre ligne.

Mon probleme est que je désire que vérifier les doublons de mon tableau a partir de la 5° ligne (A5)
Que dois je modifier.

Ci dessous la partie de programme me concernant


Sub Supprlignes_entieres_doublons()

'
Dim Cell As Range
Dim Ligne As Integer, i As Integer
Dim M As Byte, j As Byte, N As Byte
Dim Tableau(), Tableau2()
Dim Cible As String, Resultat As String
Dim U As Boolean

Ligne = Range("A65536").End(xlUp).Row ' derniere ligne non vide colonne A
M = 1
N = 1
ReDim Preserve Tableau(M) 'tableau valeurs uniques colonne A
ReDim Preserve Tableau2(N) ' tableau pour numero de lignes doublons

Application.ScreenUpdating = False
For Each Cell In Range("A1:A" & Ligne)
U = False
Cible = Cell
''
For j = 1 To 6 ' adapter selon nombre de colonnes pour chaque
Cible = Cible & Cell.Offset(0, j)
Next j
''
For i = 1 To M
If Cible = Tableau(i - 1) Then '
Tableau2(N - 1) = Cell.Row ' recupere numero de ligne quand un doublon est detecté
N = N + 1
ReDim Preserve Tableau2(N)
U = True
End If
Next i

If Tableau(M - 1) = "" And U = False Then
Tableau(M - 1) = Cible ' remplissage tableau valeurs uniques si pas de doublon détecté
M = M + 1
ReDim Preserve Tableau(M)
End If
Next Cell

For i = N - 1 To 1 Step -1 ' boucle pour supprimer les lignes de doublons
Rows(Tableau2(i - 1)).delete
Next i
Application.ScreenUpdating = True

End Sub


Merci d'avance pour vos réponses

 

[TheLio]

Re : Suppression ligne

Hello,
Ca doit se passer par ici
For Each Cell In Range("A1:A" & Ligne)
A++
Lio

 

[Roland_M]

Re : Suppression ligne

bonjour

veux tu essayer avec ceci !?

Sub Supprlignes_entieres_doublons()
Application.ScreenUpdating = False
Dim MonDico As Variant: Set MonDico = CreateObject("Scripting.Dictionary")
NoPremLig = 5 'prem ligne de départ
NoDernLig = Cells(Rows.Count, "A").End(xlUp).Row 'dern ligne en colonne A
'
NoLig = NoPremLig
Do While NoLig <= NoDernLig
   If Cells(NoLig, "A") <> "" Then
      Var$ = ""
      For C = 1 To 6 'collecte données sur 6 colonnes
        Var$ = Var$ & Cells(NoLig, C)
      Next
      If Not MonDico.Exists(Var$) Then 'ajoute
         MonDico.Add Var$, Var$: NoLig = NoLig + 1
      Else 'suppr car existe déjà
         Rows(NoLig).EntireRow.Delete
      End If
   Else
      NoLig = NoLig + 1
   End If
Loop
Set MonDico = Nothing
Application.ScreenUpdating = True
End Sub