XL 2010 VBA : Boucle For each qui ne s'arrête pas

Gllou06

XLDnaute Nouveau
Bonjour à tous
Pour commencer, sachez que je ne suis pas un pro de la macro ni un habitué des forums mais voilà deux jours que je cherche une solution sur les sites sans trouver vraiment une réponse à mon problème !

Aujourd'hui, je tente de faire une boucle sur une colonne pour effacer les doublons en (conservant le premier) : tout se passe bien au niveau de l'action mais je dois faire une erreur puisque ma boucle "For each" ne s'arrête pas à la fin de ma liste. Quelqu'un peut-il me dire où est cette erreur ? (mon code -ci-joint- n'est peut-être pas "très propre" non plus... !).

A savoir : cette feuille ne sera pas visible par les utilisateurs (donc pas possible de passer par les filtres élaborés) c'est pourquoi je veux passer par une macro et, d'autre part je ne veux pas supprimer la ligne mais seulement effacer le contenu dupliqué. (Voir l'extrait joint).

Je suis preneur de toutes vos suggestions et vous remercie par avance.
 

Pièces jointes

  • Efface doublons.xlsm
    34.3 KB · Affichages: 41

JCGL

XLDnaute Barbatruc
Bonjour à tous,
Salut Robert (C'est toi...),

Pourquoi 2 boucles :
une For Each
une While... Wend

Peux-tu essayer :

VB:
Option Explicit

Sub Efface_Doublons()
Dim Derl&, Lig&
Derl = Feuil5.Range("G" & Rows.Count).End(xlUp).Row
    Range("E6:E" & Derl).Formula = "=COUNTIF(R6C6:RC[1],RC[1])"
For Lig = 6 To Derl
If Cells(Lig, "E") > 1 Then Cells(Lig, "F").ClearContents
Next Lig
Range("E6:E" & Derl) = ""
End Sub

A+ à tous
 
Dernière édition:

ROGER2327

XLDnaute Barbatruc
Bonsoir à tous.

Et pourquoi pas, en supposant qu'il existe un onglet nommé «Feuil1», tout simplement :
VB:
Sub EffaceDoublons()
Dim Cell As Range, donnée1 As String
    For Each Cell In Sheets("Feuil1").Range("F6:F" & Range("G1048576").End(xlUp).Row)
        If Cell.Value = donnée1 Then Cell.Clear Else donnée1 = Cell.Value
    Next
End Sub
Bonne nuit.

ℝOGER2327
#8496


Lundi 23 Gueules 144 (Occultation de Saint J. Torma, euphoriste - fête Suprême Quarte)
29 Pluviôse An CCXXV, 9,8566h - chélidoine
2017-W07-5T23:39:21Z
 

ROGER2327

XLDnaute Barbatruc
Suite...

... si on veut la mise en forme :
VB:
Sub EffaceDoublons()
Dim Plg As Range, Cell As Range, donnée1 As String, donnée2 As String
    With WorkSheets("Feuil1")
        Set Plg = .Range("F6:F" & .Range("G1048576").End(xlUp).Row)
        With Plg
            With .Resize(, 2)
                With .Borders: .LineStyle = xlContinuous: .Item(xlInsideHorizontal).LineStyle = xlNone: End With
                .VerticalAlignment = xlCenter
                .UnMerge
            End With
        End With
        For Each Cell In Plg
            If Cell.Value = donnée1 Then Cell.ClearContents Else donnée1 = Cell.Value
        Next
        For Each Cell In Plg
            If Cell.Value <> "" Then
                On Error Resume Next
                With .Range(.Range(donnée1), .Range(donnée2))
                    With .Resize(, 2).Borders: .LineStyle = xlContinuous: .Item(xlInsideHorizontal).LineStyle = xlNone: End With
                    .Merge
                End With
                On Error GoTo 0
                donnée1 = Cell.Address
            End If
            donnée2 = Cell.Address
        Next
        With .Range(.Range(donnée1), .Range(donnée2))
            With .Resize(, 2).Borders: .LineStyle = xlContinuous: .Item(xlInsideHorizontal).LineStyle = xlNone: End With
            .Merge
        End With
    End With
End Sub

ℝOGER2327
#8497


Mardi 24 Gueules 144 (Conversion de Saint Matorel, bateleur - fête Suprême Quarte)
30 Pluviôse An CCXXV, 0,4157h - traineau
2017-W07-6T00:59:52Z
 

Discussions similaires

  • Résolu(e)
Microsoft 365 Boucle FOR
Réponses
7
Affichages
307
Réponses
21
Affichages
499

Statistiques des forums

Discussions
312 884
Messages
2 093 252
Membres
105 658
dernier inscrit
Mario Richard