Supprimer les lignes identiques [Résolu/Fermé]

Signaler
Messages postés
122
Date d'inscription
vendredi 2 octobre 2015
Statut
Membre
Dernière intervention
3 mars 2017
-
 Elpeligro -
Salut , j'ai eu ce code la qui me permette d'effacer les lignes identique , mais malheureusement il prend en consideration la formule de la cellule et pas la valeur j'ai remplacé cette ligne

Cible = Cell
par
Cible = Cell.value 


mais c'Est toujours la meme chose

voici le code au complet :
Option Explicit

Sub SupprimerLignesDoublons()

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
M = 1
N = 1
ReDim Preserve Tableau(M)
ReDim Preserve Tableau2(N)

Application.ScreenUpdating = False
For Each Cell In Range("A2:A" & Ligne)
U = False
Cible = Cell

For j = 1 To 42
Cible = Cible & Cell.Offset(0, j)
Next j
For i = 1 To M
If Cible = Tableau(i - 1) Then '
Tableau2(N - 1) = Cell.Row
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
M = M + 1
ReDim Preserve Tableau(M)
End If
Next Cell

End Sub


1 réponse

Messages postés
1769
Date d'inscription
lundi 7 avril 2008
Statut
Membre
Dernière intervention
15 juin 2020
575
Essayer avec ce code qui supprime les lignes identiques dans la plage utilisée pour les colonnes 1 à 42

Sub SupprimerLignesDoublons()

Dim i As Integer
Dim colonnes()

With ActiveSheet.UsedRange
For i = 0 To 41
ReDim Preserve colonnes(i)
colonnes(i) = i + 1
Next
.RemoveDuplicates Columns:=(colonnes), Header:=xlNo
End With

End Sub


--
 
1
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 63550 internautes nous ont dit merci ce mois-ci

Hello,

y a un truc qui liu plait pas ici :

.RemoveDuplicates Columns:=(colonnes), Header:=xlNo