Eliminer doublons dans une suite de chiffres séparés par des virgules.

Version imprimable

30/07/2015, 16h09
benji971

Eliminer doublons dans une suite de chiffres séparés par des virgules.

Bonjour,

j'ai une suite de chiffres de longueur variable. Ils seront toujours séparé par des virgules. il peut y avoir 1,2,3 ou 6 chiffres qui forment le nombre.

eX: 36,210,429,36,11,430,431,4,7,9,1334

J'aimerais faire une fonction qui éliminent les doublons dans cette suite de chiffres.

j'avais pensé à la fonction split() et à une boucle mais je ne suis pas sur que ce soit la meilleur méthode.
j'ai peur de faire quelque chose de trop lourd.

Si quelqu'un à une solution optimisée je suis preneur.

Merci d'avance.

J'ai codé ça. A priori ça fonctionne mais il y a peut être moyen de le purger un peu j'imagine :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Public Function EliminerDoublonsCategories(Cat1 As Variant)
 
Dim CatFinalSansDoublons As String
CatFinalSansDoublons = ","
 
If Not IsNull(Cat1) And Not IsEmpty(Cat1) And Not Cat1 = "" Then
SplitCategoryFinal = Split(Cat1, ",")
i = 0
While Not i > UBound(SplitCategoryFinal)
    If CatFinalSansDoublons Like "*," & SplitCategoryFinal(i) & ",*" Then
    Else
    CatFinalSansDoublons = CatFinalSansDoublons & SplitCategoryFinal(i) & ","
    End If
i = i + 1
Wend
Else
End If
'On enlève les virgules de chaque côté.
CatFinalSansDoublons = Right(CatFinalSansDoublons, Len(CatFinalSansDoublons) - 1)
CatFinalSansDoublons = Left(CatFinalSansDoublons, Len(CatFinalSansDoublons) - 1)
 
EliminerDoublonsCategories = CatFinalSansDoublons
End Function

Bonjour,

Un peu plus court :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Public Function ChasseDoublons(Original As String) As String
  Dim t() As String
  Dim i As Integer
  Dim j As Integer
  t = Split(Original, ",")
  For i = 0 To UBound(t) - 1
    For j = i + 1 To UBound(t)
      If t(i) = t(j) Then t(j) = "Doublon"
    Next j
  Next i
  For i = 0 To UBound(t)
    If t(i) <> "Doublon" Then ChasseDoublons = ChasseDoublons & t(i) & ","
  Next i
  'Supprimer la dernière virgule
  ChasseDoublons = Left(ChasseDoublons, Len(ChasseDoublons) - 1)
End Function

30/07/2015, 18h24
benji971

Merci pour l'optimisation c'est déjà plus propre :)

Hello !

Encore plus court...

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Public Function DelDoublons(aDblons As String) As String
Dim sTemp()     As String
Dim I           As Integer
Dim PosCur      As Integer
 
    sTemp = Split(aDblons, ",")
 
    For I = 0 To UBound(Split(aDblons, ",", -1, vbBinaryCompare))
        PosCur = PosCur + Len(sTemp(I)) + 1
        If InStr(PosCur, aDblons, sTemp(I)) = 0 Then DelDoublons = DelDoublons & ", " & sTemp(I)
    Next I
 
    If Left(DelDoublons, 2) = ", " Then DelDoublons = Right(DelDoublons, Len(DelDoublons) - 2)
 
End Function

Cordialement

30/07/2015, 19h58
ClaudeLELOUP

Élégant !

http://claudeleloup.developpez.com/&99/L3218.jpg

... Mais :

http://claudeleloup.developpez.com/&99/L3222.jpg

Un peu trop court : 36 manque ! (Car 36 est inclus dans 360.)

... Donc, il faudrait en plus vérifier que les deux « champs » ont la même longueur (ou sont égaux).

Ou alors, d'abord ajouter un caractère insolite (un pipe par exemple) à la droite de chaque champ et l'éliminer dans le résultat.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Public Function DelDoublons2(aDblons As String) As String
Dim sTemp()     As String
Dim I           As Integer
Dim PosCur      As Integer
 
    aDblons = aDblons & "|"       'un pipe à la droite du dernier
    sTemp = Split(Replace(aDblons, ",", "|,"), ",") 'un pipe à la droite de chaque autre
 
 
    For I = 0 To UBound(Split(aDblons, ",", -1, vbBinaryCompare))
        PosCur = PosCur + Len(sTemp(I)) + 1
        If InStr(PosCur, aDblons, sTemp(I)) = 0 Then DelDoublons2 = DelDoublons2 & ", " & sTemp(I)
    Next I
        DelDoublons2 = Replace(DelDoublons2, "|", "") ' pour éliminer les pipes
    If Left(DelDoublons2, 2) = ", " Then DelDoublons2 = Right(DelDoublons2, Len(DelDoublons2) - 2)
 
End Function

http://claudeleloup.developpez.com/&99/L3223.jpg

31/07/2015, 13h35
bernardmichel

Bien vu !

:bravo: