Supprimer les lignes identiques

Résolu/Fermé
r4944 Messages postés 122 Date d'inscription vendredi 2 octobre 2015 Statut Membre Dernière intervention 3 mars 2017 - 11 juil. 2016 à 19:56
 Elpeligro - 16 avril 2020 à 13:10
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

thev Messages postés 1884 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 17 novembre 2024 691
Modifié par thev le 11/07/2016 à 20:55
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
Hello,

y a un truc qui liu plait pas ici :

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