IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

VBA Access Discussion :

Eliminer doublons dans une suite de chiffres séparés par des virgules. [AC-2007]


Sujet :

VBA Access

  1. #1
    Membre du Club
    Homme Profil pro
    Webmaster
    Inscrit en
    Octobre 2014
    Messages
    73
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 38
    Localisation : Antilles Néerlandaises

    Informations professionnelles :
    Activité : Webmaster

    Informations forums :
    Inscription : Octobre 2014
    Messages : 73
    Points : 62
    Points
    62
    Par défaut 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.

  2. #2
    Membre du Club
    Homme Profil pro
    Webmaster
    Inscrit en
    Octobre 2014
    Messages
    73
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 38
    Localisation : Antilles Néerlandaises

    Informations professionnelles :
    Activité : Webmaster

    Informations forums :
    Inscription : Octobre 2014
    Messages : 73
    Points : 62
    Points
    62
    Par défaut
    J'ai codé ça. A priori ça fonctionne mais il y a peut être moyen de le purger un peu j'imagine :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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

  3. #3
    Rédacteur/Modérateur

    Avatar de ClaudeLELOUP
    Homme Profil pro
    Chercheur de loisirs (ayant trouvé tous les jours !)
    Inscrit en
    Novembre 2006
    Messages
    20 594
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 78
    Localisation : Belgique

    Informations professionnelles :
    Activité : Chercheur de loisirs (ayant trouvé tous les jours !)
    Secteur : Finance

    Informations forums :
    Inscription : Novembre 2006
    Messages : 20 594
    Points : 282 192
    Points
    282 192
    Par défaut
    Bonjour,

    Un peu plus court :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    SVP ne m'envoyez pas de messages privés pour poser des questions techniques, vous n'aurez pas de réponse !

  4. #4
    Membre du Club
    Homme Profil pro
    Webmaster
    Inscrit en
    Octobre 2014
    Messages
    73
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 38
    Localisation : Antilles Néerlandaises

    Informations professionnelles :
    Activité : Webmaster

    Informations forums :
    Inscription : Octobre 2014
    Messages : 73
    Points : 62
    Points
    62
    Par défaut
    Merci pour l'optimisation c'est déjà plus propre

  5. #5
    Membre expérimenté Avatar de bernardmichel
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Janvier 2004
    Messages
    1 181
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Vaucluse (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Développeur informatique

    Informations forums :
    Inscription : Janvier 2004
    Messages : 1 181
    Points : 1 591
    Points
    1 591
    Par défaut
    Hello !

    Encore plus court...
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    Nous n'héritons pas la Terre de nos ancêtres, nous l'empruntons à nos enfants, prenons-en soin !
    (proverbe amérindien)

  6. #6
    Rédacteur/Modérateur

    Avatar de ClaudeLELOUP
    Homme Profil pro
    Chercheur de loisirs (ayant trouvé tous les jours !)
    Inscrit en
    Novembre 2006
    Messages
    20 594
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 78
    Localisation : Belgique

    Informations professionnelles :
    Activité : Chercheur de loisirs (ayant trouvé tous les jours !)
    Secteur : Finance

    Informations forums :
    Inscription : Novembre 2006
    Messages : 20 594
    Points : 282 192
    Points
    282 192
    Par défaut
    Élégant !


    SVP ne m'envoyez pas de messages privés pour poser des questions techniques, vous n'aurez pas de réponse !

  7. #7
    Rédacteur/Modérateur

    Avatar de ClaudeLELOUP
    Homme Profil pro
    Chercheur de loisirs (ayant trouvé tous les jours !)
    Inscrit en
    Novembre 2006
    Messages
    20 594
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 78
    Localisation : Belgique

    Informations professionnelles :
    Activité : Chercheur de loisirs (ayant trouvé tous les jours !)
    Secteur : Finance

    Informations forums :
    Inscription : Novembre 2006
    Messages : 20 594
    Points : 282 192
    Points
    282 192
    Par défaut
    ... Mais :



    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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

    SVP ne m'envoyez pas de messages privés pour poser des questions techniques, vous n'aurez pas de réponse !

  8. #8
    Membre expérimenté Avatar de bernardmichel
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Janvier 2004
    Messages
    1 181
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Vaucluse (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Développeur informatique

    Informations forums :
    Inscription : Janvier 2004
    Messages : 1 181
    Points : 1 591
    Points
    1 591
    Par défaut
    Bien vu !

    Nous n'héritons pas la Terre de nos ancêtres, nous l'empruntons à nos enfants, prenons-en soin !
    (proverbe amérindien)

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 6
    Dernier message: 08/01/2014, 15h26
  2. lien avec des chiffres séparés par des points
    Par dominos dans le forum Langage
    Réponses: 2
    Dernier message: 18/12/2013, 18h36
  3. Réponses: 1
    Dernier message: 22/10/2013, 23h57
  4. Réponses: 0
    Dernier message: 14/08/2012, 09h03
  5. Lignes d'une colone séparés par des virgules.
    Par Wahid.Net dans le forum MS SQL Server
    Réponses: 5
    Dernier message: 09/02/2008, 02h47

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo