Supprimer des doublons avec des conditions version 2

[bobjazz]

Bonjour le Forum,

J'ai déjà demander votre aide sur ce sujet la semaine dernière, mais comme d'habitude quand cela fonctionne, on va plus loin dans nos fichiers, donc j'ai une autre demande pour faire évoluer le code que Robert m'avait fait que j'adapte sur un autre sujet.
Le code de Robert contrôle les doublons avec comme référence la colonne D, on supprime les doublons et en plus comme condition si la cellule dans la colonne L est non vide, on garde les lignes.
Je voudrait faire la même chose, mais en prenant en compte que si une cellule entre L et S contient une donnée, je garde la ligne, et là depuis hier soir, je reconnais que je seiche.

Voilà le code de Robert :

Sub supprimeDoublons1()

Dim MaCellule As Range 'déclare la variable MaCellule
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim x As Integer 'déclare la variable x (incrément)
Dim donnee1 As String 'déclare la variable donnee1 (type à adapter à ton cas)

Set MaCellule = Range("D2") 'définit la variable MaCellule
MaCellule.CurrentRegion.Sort Key1:=MaCellule, Order1:=xlAscending, Header:=xlYes 'tri croissant par rapport à la colonne D de la plage des cellules adjacentes à MaCellule
dl = Cells(Application.Rows.Count, 4).End(xlUp).Row 'définit la dernière ligne de la colonne D (4)
For x = dl To 2 Step -1 'boucle inversée de la dernière ligne à la ligne 2
donnee1 = Cells(x, 4).Value 'définit la variable donnee1
If Application.WorksheetFunction.CountIf(Range("D2😀" & dl), Cells(x, 4)) > 1 Then 'condition : si il y a plusieurs occurrences de la cellule dans la plage D2😀&dl
If Cells(x, 13).Value = "" Then Rows(x).Delete 'si la cellule de la colonne L est vide, supprime la ligne
End If
'si la cellule de la colonne L est vide, supprime la ligne
End If 'fin de la condition
Next x 'prochaine ligne de la boucle
End Sub

Joins un fichier pour expliquer

Merci d'avance

Bobjazz

 

[bobjazz]

Re : Supprimer des doublons avec des conditions version 2

Bonsoir le Forum,

Je suis coincé depuis ce début d'après-midi, j'ai 10 onglets avec des nombres de lignes environ 24000.
Je viens de passer un onglet mais je passe par des fonctions, SI OU, =SI(NB.SI($C$1:C3;C3)>1;"Doublon";""), cela avance pas
Est ce quelqu'un peut m'aider.
Encore merci

Bobjazz

 

[laetitia90]

Re : Supprimer des doublons avec des conditions version 2

bonjour bobjazz
une derniere tentative avant que les conditions changent encore??

Sub es()
Dim m As Object, i As Long, z As Variant
Application.ScreenUpdating = False
Range("A2" & ":s" & Cells(Rows.Count, 4).End(xlUp).Row).Sort Key1:=Range("d2"), Order1:=xlAscending, Header:=xlYes
Set m = CreateObject("Scripting.Dictionary")
For i = Cells(Rows.Count, 4).End(xlUp).Row To 2 Step -1
z = Cells(i, 4) & " " & Cells(i, 12) & " " & Cells(i, 13) & " " & Cells(i, 14) & " " & Cells(i, 15) _
& " " & Cells(i, 16) & " " & Cells(i, 17) & " " & Cells(i, 18) & " " & Cells(i, 19)
If Not m.Exists(z) Then m.Add z, z Else Rows(i).Delete
Next i
Set m = Nothing
For i = Cells(Rows.Count, 4).End(xlUp).Row To 2 Step -1
If Cells(i, 4) = Cells(i - 1, 4) Then
If Application.WorksheetFunction.CountA(Range(Cells(i, 12), Cells(i, 19))) = 0 Then Rows(i).Delete
If Application.WorksheetFunction.CountA(Range(Cells(i - 1, 12), Cells(i - 1, 19))) = 0 Then Rows(i - 1).Delete
End If
Next i
End Sub

 

[bobjazz]

Re : Supprimer des doublons avec des conditions version 2

Re laetitia90

Encore merci de ta patience.
Non c'est fini, je suis arrivé au résultat que je voulais.
Quelle gain de temps et surtout de sécurité. Plus d'erreur pas rapport avant.

Encore Merci

Bobjazz