Effacer doublons sur 1 ligne puis passer à la suivante

alpilon

XLDnaute Junior
Bonjour

dans une procédure de Data Mining je cherche à effacer les doublons d'une première plage ("C14:AD14") puis à faire de même sur celle du dessous ("C15:AD15") jusquà la ligne ("C43:AD43")

mais l'une après l'autre car les lignes sont des supports différents

voici le code que j'ai adapté, mais qui ne fonctionne que pour la première plage

Code:
Sub doublons()

 
 Dim Fin As Range, i As Long, J As Long, Row As Integer
 Dim ModeCalcul As Long
 
 With Application
  ModeCalcul = .Calculation
  .Calculation = xlCalculationManual
  .ScreenUpdating = False
 End With
 
 Row = Range("C14").Row
 Set Fin = Range("AD14")
 
 On Error Resume Next
 Do
 i = J + 1
 J = Range(Cells(Row, i), Fin).RowDifferences(Cells(Row, i))(0).Column
 If Err Then Exit Do
 If J > i Then Range(Cells(Row, i + 1), Cells(Row, J)).ClearContents
 Loop
 If i < Fin.Column Then Range(Cells(Row, i + 1), Fin).ClearContents
 
 Application.Calculation = ModeCalcul
 
 End Sub

pouvez-vous m'aider ?

Merci
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Effacer doublons sur 1 ligne puis passer à la suivante

Bonjour Alpilon, bonjour le forum,

Peut-être comme ça :
Code:
Sub doublons()
Dim cel1 As Range, cel2 As Range
Dim ad As String
Dim ModeCalcul As Long
 
With Application
    ModeCalcul = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With
 
For li = 14 To 43
    For Each cel1 In Range(Cells(li, 3), Cells(li, 30))
        ad = cel1.Address
        For Each cel2 In Range(Cells(li, 3), Cells(li, 30))
            If cel2.Value <> "" Then
                If cel2.Value = cel1.Value And cel2.Address <> ad Then cel2.ClearContents
            End If
        Next cel2
    Next cel1
Next li
Application.Calculation = ModeCalcul
End Sub
 

Statistiques des forums

Discussions
311 733
Messages
2 082 019
Membres
101 872
dernier inscrit
Colin T