1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96
| Public Sub Suppression_doublons()
'Les déclarations des variables
Dim sNumTel As String, sNom As String, sAdd As String, iCP As String
Dim iNb_Lignes As Integer
Dim rCible As Range, iLigne As Integer, rRgeA As Range, rRgeB As Range
'initialisation des variables
iPos1 = 0
iPos2 = 0
iNb_Lignes = ActiveSheet.UsedRange.Rows.Count
'Boucle sur toutes les lignes du fichier
For i = 1 To iNb_Lignes Step 1
'On en profite pour faire le transfert des numéros de mobile de la colonne "fixe" vers la colonne "mobile"
'#####################################
If Left(Range("E" & i).Value, 2) = "06" Then
If Range("G" & i).Value = "" Then
Range("E" & i).Cut
Range("G" & i).Select
ActiveSheet.Paste
Else
Range("E" & i).Select
Selection.ClearContents
End If
End If
'On en profite pour faire la Suppression des parasites symbolisés par "-" dans la colonne B
'#####################################
'Dans la colonne B, on ne veut garder que les données se trouvant APRES le dernier tiret
sChaine = Range("B" & i).Value
iPos1 = InStr(sChaine, "-")
If iPos1 <> 0 Then
iPos2 = InStr(iPos1 + 1, sChaine, "-")
If iPos2 <> 0 Then
iPos1 = iPos2
End If
sChaine = Right(sChaine, Len(sChaine) - 1 - iPos1)
Range("B" & i).Value = sChaine
End If
'Suppression des doublons
'#####################################
sNumTel = Range("E" & i).Value
sNom = Range("A" & i).Value
iCP = Range("C" & i).Value
sAdd = Range("B" & i).Value
If sNumTel <> "" Then
Set rCible = Range("E" & i + 1 & ":E" & iNb_Lignes).Find(what:=sNumTel, lookat:=xlWhole)
If Not rCible Is Nothing Then
iLigne = rCible.Row
'On supprime un doublons uniquement si les colonnes A,B et C sont identiques
If Range("A" & iLigne) = sNom Then
If Range("B" & iLigne) = sAdd Then
If Range("C" & iLigne) = iCP Then
rRgeA = Range("A" & i & ":K" & i)
rRgeB = Range("A" & iLigne & ":K" & iLigne)
'La fonction "Compter_champs_non_vides compte le nombre de colonne non vide dans le range mit en paramètre.
'La ligne contenant le plus de colonne vide est supprimée
If Compter_champs_non_vide(rRgeA) > Compter_champs_non_vide(rRgeB) Then
Range("A" & iLigne).EntireRow.Delete
i = i - 1
iNb_Lignes = ActiveSheet.UsedRange.Rows.Count
ElseIf i <> iLigne Then
Range("A" & i).EntireRow.Delete
i = i - 1
iNb_Lignes = ActiveSheet.UsedRange.Rows.Count
End If
End If
End If
End If
End If
End If
Next i
End Sub
Function Compter_champs_non_vide(rCible As Range) As Integer
Dim Cellules As Range
Compter_champs_non_vide = 0
For Each Cellules In rCible
If Cellules.Text <> "" Then
Compter_champs_non_vide = Compter_champs_non_vide + 1
End If
Next
End Function |
Partager