Regrouper des doublons présents dans une seule cellule

[yannoch]

Bonjour à tous,

encore un sujet traitant des doublons, mais j'ai beau chercher, je trouve beaucoup, beaucoup (beaucoup encore) de choses pour éliminer les doublons mais rien pour les conserversur ce que je cherche (j'ai peut-être mal cherché).

Information de départ, on reste toujours sur la même cellule.
Mon problème est simple, je rempli une cellule avec les informations suivantes :

Categorie01(config1) ; Categorie02(config2,config3) ; Categorie03(config3) ; Categorie01(config1)

Chaque "bloc" de text est séparé par des " ; ", de plus ils seront toujours de la forme texte(texte1) ou texte(texte1,texte2).

Et comme on peut le voir dans l'exemple ci-dessus, il y a deux blocs identiques "Categorie01(config1)".

Ce que je souhaiterai donc avoir, serait de pouvoir regrouper ces blocs identiques une fois que j'ai fini de remplir ma cellule et avoir la chose suivante :

2xCategorie01(config1) ; Categorie02(config2,config3) ; Categorie03(config3) ;

notez bien le 2x devant le bloc "Categorie01(config1)".
Et bien sûr, il peut y avoir 3, 4, 5, etc... blocs identiques.

Voilà, si vous n'avez rien qu'une piste ou la soluce complète, je suis preneur.

Merci d'avance pour vos réponse

 

[Pierrot93]

Re : Regrouper des doublons présents dans une seule cellule

Bonsoir Yannoch

regarde le code ci dessous, teste la cellule A1 et renvoie le résultat en A2 :

Option Explicit
Sub test()
Dim i As Byte, j As Byte, t As Variant, x As Byte, z As String
t = Split(Range("A1").Value, " ; ")
For i = LBound(t) To UBound(t)
    x = 0
    For j = i + 1 To UBound(t)
        If t(i) = t(j) Then t(j) = "": x = x + 1
    Next j
    If t(i) <> "" Then z = z & IIf(x = 0, t(i), x + 1 & "x" & t(i)) & " ; "
Next i
Range("A2").Value = Left(z, Len(z) - 3)
End Sub

tu peux éventuellement l'adapter, afin de le positionner dans une macro événementielle... a voir selon ton besoin.

bonne soirée
@+

 

[yannoch]

Re : Regrouper des doublons présents dans une seule cellule

Bonsoir à tous (ou Bonjour à tous ),
je reviens sur ce poste ou je viens de m'apercevoir que j'a boulié de remercier Pierrot (sa solution marche nickel) pour savoir s'il est possible de faire une petite amélioration.
En effet, sa macro permet de regrouper les doublons dans une cellule, ce que je souhaiterai savoir est est-ce que la macro peut s'exécuter sur une série ce cellule qui sont sur la même feuille mais qui ne se suive pas du tout (du genre : A3, A9, M3, M21...etc...). Et bien sûr quelle façon ?
La seule solution à mon niveau est de devoir le repéter en déclarant autant de variable que de cellule, sachant que j'en ai 16 à traiter, c'est un peu fastidieux de devoir réecrire 16 fois le code en changeant toutes les variables à chaque fois

voilà, merci d'avance pour vos réponses (je n'oublierai pas de répondre cette fois-ci )

 

[BOISGONTIER]

Re : Regrouper des doublons présents dans une seule cellule

Bonjour,

Function sansdoublonsCel(cel)
  Application.Volatile
  Set mondico = CreateObject("Scripting.Dictionary")
  tbl = Split(cel, ";")
  For Each c In tbl
    If Not mondico.Exists(Trim(c)) Then mondico.Add Trim(c), Trim(c)
  Next
  For Each c In mondico.items
    n = 0
    For Each d In tbl
      If c = Trim(d) Then n = n + 1
    Next d
    temp = temp & IIf(n > 1, n & "x", "") & c & ";"
  Next c
  sansdoublonsCel = Left(temp, Len(temp) - 1)
End Function

Dans le tableur:

=sansdoublonscel(A1)

Pour modifier les cellules existantes:

Sub essai()
  For Each c In Range("A1:A2,C3:C6")
    c.Value = sansdoublonsCel(c)
  Next c
End Sub

JB
Formation Excel VBA JB

 

[Pyrof]

Re : Regrouper des doublons présents dans une seule cellule

Bonjour,

on peut faire
For Each c In tbl
c=trim(c)
If isempty(mondico(c))Then
mondico(c)=1
else
mondico(c)=mondico(c)+1
end if
Next

 

[BOISGONTIER]

Re : Regrouper des doublons présents dans une seule cellule

La fonction devient:

Function sansdoublonsCel(cel)
  Application.Volatile
  Set mondico = CreateObject("Scripting.Dictionary")
  tbl = Split(cel, ";")
  For Each c In tbl
    mondico(Trim(c)) = IIf(mondico.exists(Trim(c)), mondico(Trim(c)) + 1, 1)
  Next
  For Each c In mondico
    temp = temp & IIf(mondico(c) > 1, mondico(c) & "x", "") & c & ";"
  Next
  sansdoublonsCel = Left(temp, Len(temp) - 1)
End Function

JB

 

[yannoch]

Re : Regrouper des doublons présents dans une seule cellule

Bonjour à tous,

merci BOISGONTIER (merci Pyrof aussi) , mais malheureusement je n'arrive pas du tout à exploiter ta solution, sûrement du au fait que je ne sais pas du tout comment la mettre en place.
Par exemple, pour la macro de Pierrot, je l'ai mis directement dans le code de la page où se trouve les doublons à regrouper, j'ai associé un bouton à cette macro et ça a marché directement.
Ce qui me donnait rapidement:

Private Sub bouton_Click()
macro de pierrot sans Sub test()
End sub

Pour ta macro qui est apparemment en deux parties, j'ai fait la même chose, sauf que j'ai associé le bouton à la partie "Sub essai()" puisqu'apparemment c'est là qu'on déclare la plage de cellule, mais j'obtiens le message d'erreur suivant:
Erreur d'exécution '5':
Argument ou appel de la procédure incorrect
>clique sur débogage, et il pointe sur la ligne sansdoublonsCel = Left(temp, Len(temp) - 1).

J'ai pourtant testé directement sur ton fichier en mettant un bouton puis de l'associer à la macro essai, et ça marche.
Donc je comprend plus rien, j'ai vu qu'il y avait 2 modules dans ton classeur mais j'arrive pas à comprendre la relation entre les deux, et ne sait pas si le module2 est vraiment utile quand on appelle la macro par bouton.

 

[BOISGONTIER]

Re : Regrouper des doublons présents dans une seule cellule

Bonjour,

La fonction est dans un module standard (Alt+f11 puis insertion/module)

JB

 

[yannoch]

Re : Regrouper des doublons présents dans une seule cellule

j'ai compris ce qui n'allait pas après une vingtaine d'essai, c'est à cause du format de mes cellules.
La macro va s'éxecuter tant qu'elle ne passe pas sur un bloc de cellules fusionnées, quand la macro tombe sur ce bloc, elle va quand même y regrouper les doublons mais elle ne sait apparemment pas en sortir donc j'ai le fameux message d'erreur "Erreur d'exécution '5':"
Donc la solution est de ne pas mettre une plage ou une suite de plage de cellule à scanner, mais seulement une suite de cellule:
[A1:A2,C3:C6] >> pas bon
[A1,A2,C3,C4,C5,C6] >> Ok!

Maintenant ça marche nickel, merci encore BOISGONTIER

 

[BOISGONTIER]

Re : Regrouper des doublons présents dans une seule cellule

[A1:A2,C3:C6] >> pas bon

mais

Range("A1:A2,C3:C6") >> Bon

JB

 

[yannoch]

Re : Regrouper des doublons présents dans une seule cellule

Range("A1:A2,C3:C6") >> Bon

Je viens de tester, ça ne marche pas, ça doit être encore lié aux cellules fusionnées. Mais c'est pas grave, j'ai que 16 cellules et elles ne changent jamais.

Par contre, j'ai un autre problème maintenant , si une des cellules à traiter est vide, la macro plante de nouveau, donc il faudrait ajouter un petit test pour savoir si la cellule est à traiter ou non (vide ou pleine) mais je ne vois pas comment le rajouter

 

[BOISGONTIER]

Re : Regrouper des doublons présents dans une seule cellule

  For Each c In Range("A1:A2,C3:C6")
    If Not IsEmpty(c) Then c.Value = sansdoublonsCel(c)
  Next c

JB