excel 2000 suppression mots récurents ?

  • Initiateur de la discussion Initiateur de la discussion klip89
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

K

klip89

Guest
Bonjour,

comment peut-on supprimer dans excel2000 un mot qui apparait 2 fois ou plus pour qu'il disparaisse complètement et ne garder que les mots uniques qui n'ont pas de doublons dans la colonne ?

merci pour vos réponses

isabelle
 
Re : excel 2000 suppression mots récurents ?

Bonsoir,

essaie ce code si tes données sont dans la colonne A, sinon, tu adaptes

Code:
Sub supp_doublons()
Dim Uniques As Object, Cel As Range
Set Uniques = CreateObject("Scripting.Dictionary")
  For Each Cel In Range("A1:A" & [A65000].End(xlUp).Row)
     If Not Uniques.Exists(Cel.Value) Then Uniques.Add Cel.Value, Cel.Value
  Next Cel
Range("A:A").ClearContents
Range("A1:A" & Uniques.Count) = Application.Transpose(Uniques.items)
End Sub
 
Re : excel 2000 suppression mots récurents ?

Merci bien

je l'ai faites et ça supprime les doublons mais ça me laisse un exemplaire

ce que je cherche à faire c'est de supprimer les mots qui sont en plusiuers exemplaires par exemple si j'ai 3 fois le mot MANGER, ça me supprime 2 fois et me laisse manger alors que ce que je voudrais c'est que ça supprime les 3 fois et que je n'ai plus manger dans ma colonne

merci
 
Re : excel 2000 suppression mots récurents ?

Bonsoir

comme ceci? :

Code:
Sub les_seuls()
Dim Uniques As Object, Cel As Range, DerLig As Long
DerLig = [A65000].End(xlUp).Row
Set Uniques = CreateObject("Scripting.Dictionary")
    For Each Cel In Range("A1:A" & DerLig)
        If Application.CountIf(Range("A1:A" & DerLig), Cel.Value) = 1 Then Uniques.Add Cel.Value, Cel.Value
    Next Cel
Range("A:A").ClearContents
Range("A1:A" & Uniques.Count) = Application.Transpose(Uniques.items)
End Sub
 
Re : excel 2000 suppression mots récurents ?

Parfait, ça marche nickel, je te remercies beaucoup.

Dernirèe info, ça fonctionne à merveille mais que pour la colonne A, si je veux le faire pour toutes les colonnes car en fait j'ai 10 colonnes, comment fait-on ?

j'ai ajouté B au code mais là y a plus rien qui marche ?

d'avance merci de m'aiguiller, c'est très gentil.

isabelle
 
Re : excel 2000 suppression mots récurents ?

Bonsoir,

Comme bhbh (que je salue 🙂), n'est pas connecté, je te propose ceci:

Code:
Sub les_seuls()
Dim Uniques As Object, Cel As Range, DerLig As Long, Col As Long
For Col = 1 To 10 'de la colonne 1 à 10
  DerLig = Cells(65536, Col).End(xlUp).Row
  Set Uniques = CreateObject("Scripting.Dictionary")
      For Each Cel In Range(Cells(1, Col), Cells(DerLig, Col))
          If Application.CountIf(Range(Cells(1, Col), Cells(DerLig, Col)), Cel.Value) = 1 Then Uniques.Add Cel.Value, Cel.Value
      Next Cel
  Columns(Col).ClearContents
  Range(Cells(1, Col), Cells(Uniques.Count, Col)) = Application.Transpose(Uniques.items)
  Uniques.RemoveAll
Next
End Sub
 
Re : excel 2000 suppression mots récurents ?

Bonsoir,

arrivé trop tard, salut skoobi 🙂

j'avais presque le même code

avec juste une sécurité, au cas où il n'y aurait pas de cellules uniques...

Code:
Sub les_seuls()
Dim Uniques As Object, Cel As Range, DerLig As Long, Col As Byte
For Col = 1 To 10
DerLig = Cells(65000, Col).End(xlUp).Row
Set Uniques = CreateObject("Scripting.Dictionary")
    For Each Cel In Range(Cells(1, Col), Cells(DerLig, Col))
        If Application.CountIf(Range(Cells(1, Col), Cells(DerLig, Col)), Cel.Value) = 1 Then Uniques.Add Cel.Value, Cel.Value
    Next Cel
Columns(Col).ClearContents
If Uniques.Count > 0 Then
Range(Cells(1, Col), Cells(Uniques.Count, Col)).Value = Application.Transpose(Uniques.items)
End If
Uniques.RemoveAll
Next Col
End Sub

Bonne soirée

PS, et en regardant ton code, je me dis que les ressemblances sont troublantes....
Juste une différence, sur la variable Col (moi, en Byte, toi en Long)
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
9
Affichages
566
Réponses
2
Affichages
543
  • Question Question
Microsoft 365 Personal.xlsb
Réponses
4
Affichages
759
Retour