Effacer ligne au complet pour les doublons
Franc
-
franc -
franc -
Bonjour,
J'ai utilisé la formule suivante pour mettre en évidence mes doulbons. J'aimerais par la suite effacer au complet les lignes dans ma colonne A qui sont des doublons (en rouge). J'ai environ 3000 lignes
Sub Doublons()
Dim Collec As New Collection, Cell As Range, Plage As Range
On Error Resume Next
Set Plage = Application.InputBox("Plage à examiner", Type:=8)
If IsEmpty(Plage) Then Exit Sub
For Each Cell In Plage
If Cell.Value <> "" Then
Collec.Add Cell.Value, CStr(Cell.Value)
If Err <> 0 Then
Err.Clear
Cell.Interior.ColorIndex = 3
Else
Cell.Interior.ColorIndex = 4
End If
End If
Next Cell
Merci pour votre aide
J'ai utilisé la formule suivante pour mettre en évidence mes doulbons. J'aimerais par la suite effacer au complet les lignes dans ma colonne A qui sont des doublons (en rouge). J'ai environ 3000 lignes
Sub Doublons()
Dim Collec As New Collection, Cell As Range, Plage As Range
On Error Resume Next
Set Plage = Application.InputBox("Plage à examiner", Type:=8)
If IsEmpty(Plage) Then Exit Sub
For Each Cell In Plage
If Cell.Value <> "" Then
Collec.Add Cell.Value, CStr(Cell.Value)
If Err <> 0 Then
Err.Clear
Cell.Interior.ColorIndex = 3
Else
Cell.Interior.ColorIndex = 4
End If
End If
Next Cell
Merci pour votre aide
A voir également:
- Effacer ligne au complet pour les doublons
- Telecharger fl studio 20 pour pc gratuit complet - Télécharger - Édition & Montage
- Telechargement film d'action complet en francais - Télécharger - TV & Vidéo
- Partager photos en ligne - Guide
- Doublons photos - Guide
- Effacer les données de navigation sur android - Guide
1 réponse
Sub SuppressionDoublons()
Dim lngLastRow As Long, rngTemp As Long
'détermine la dernière ligne utilisée dans la feuille active
lngLastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
'ligne de départ pour la suppression
rngTemp = 1
'commence la boucle de suppression des doublons
Do While rngTemp <= lngLastRow
'supprime la ligne si elle est en rouge, réduit d'autant la dernière ligne de traitement
Do While Cells(rngTemp, 1).Interior.ColorIndex = 3
Rows(rngTemp).Delete
lngLastRow = lngLastRow - 1
Loop
'passe à la ligne suivante
rngTemp = rngTemp + 1
Loop
MsgBox "Suppression des doublons terminée !", vbInformation, "Fin"
End Sub
Dim lngLastRow As Long, rngTemp As Long
'détermine la dernière ligne utilisée dans la feuille active
lngLastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
'ligne de départ pour la suppression
rngTemp = 1
'commence la boucle de suppression des doublons
Do While rngTemp <= lngLastRow
'supprime la ligne si elle est en rouge, réduit d'autant la dernière ligne de traitement
Do While Cells(rngTemp, 1).Interior.ColorIndex = 3
Rows(rngTemp).Delete
lngLastRow = lngLastRow - 1
Loop
'passe à la ligne suivante
rngTemp = rngTemp + 1
Loop
MsgBox "Suppression des doublons terminée !", vbInformation, "Fin"
End Sub
franc
Merci beaucoup ça fonctionn à merveille.
