Effacer doublons sur 1 ligne puis passer à la suivante

[alpilon]

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

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]

Re : Effacer doublons sur 1 ligne puis passer à la suivante

Bonjour Alpilon, bonjour le forum,

Peut-être comme ça :

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

 

[alpilon]

Re : Effacer doublons sur 1 ligne puis passer à la suivante

Excellent Robert, cela fonctionne parfaitement,

Merci pour votre promptitude

bon dimanche à vous

Alpilon