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

Macros et VBA Excel Discussion :

Macro excel VBA combinaisons liste sans doublon [XL-2010]


Sujet :

Macros et VBA Excel

  1. #1
    Membre à l'essai
    Homme Profil pro
    Architecte technique
    Inscrit en
    Mai 2017
    Messages
    4
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Loiret (Centre)

    Informations professionnelles :
    Activité : Architecte technique
    Secteur : Administration - Collectivité locale

    Informations forums :
    Inscription : Mai 2017
    Messages : 4
    Par défaut Macro excel VBA combinaisons liste sans doublon
    Bonjour
    J'ai une liste de valeurs contenues dans une colonne A (val1,val,2,...,valn)
    Je souhaite combiner l'ensemble de ces valeurs dans les colonnes B et C de telle sorte à obtenir :
    Colonne B Colonne C
    Val1 Val1
    Val1 Val2
    ...
    Val1 Valn
    Val2 Val2
    Val2 Val3
    ...
    Val2 Valn
    ...
    Valn Valn

    Attention je ne souhaite pas prendre en compte la combinaison Valy, Valx si Valx, Valy existe déjà.

    Est-ce que qu'un a une petite idée Du code VBA que je pourrais utiliser.

    Merci pour votre aide.

  2. #2
    Expert confirmé
    Homme Profil pro
    Inscrit en
    Août 2010
    Messages
    3 453
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : Août 2010
    Messages : 3 453
    Par défaut
    Bonjour,

    Pas sûr d'avoir bien compris mais testes ce code pour voir si le résultat convient :
    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
     
    Sub Test()
     
        Dim Plage As Range
        Dim Cel As Range
        Dim I As Long
        Dim J As Long
     
        With Worksheets("Feuil1"): Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
     
        For Each Cel In Plage
     
            For I = Cel.Row To Plage.Count
     
                J = J + 1: Cells(J, 2).Value = Cel.Value: Cells(J, 3).Value = Cells(I, 1).Value
     
            Next I
     
        Next Cel
     
    End Sub

  3. #3
    Membre expérimenté
    Profil pro
    Inscrit en
    Juillet 2013
    Messages
    153
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juillet 2013
    Messages : 153
    Par défaut
    Bonjour,

    Une autre solution, utilisant les dictionnaires :

    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
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    Option Explicit
     
    Sub CartesianProduct()
        Const lngFIRSTROW = 1                       'Valeur à modifier selon la première ligne contenant les valeurs à combiner
        Dim lngLastRow As Long                      'Dernière ligne de la plage de données
        Dim strCellValue As String                  'Valeur de la cellule parcourue
        Dim objBufferDictionary As Object           'SCRIPTING.DICTIONARY - Comprend la liste sans doublons des valeurs contenues dans la première colonne
        Dim objResultDictionary As Object           'SCRIPTING.DICTIONARY - Comprend l'ensemble des combinaisons des valeurs uniques de la première colonne avec elle-même
        Dim strBufferValue_1 As String              'Permet de stocker temporairement une combinaison (dans l'ordre A-B)
        Dim strBufferValue_2 As String              'Permet de stocker temporairement une combinaison (dans l'ordre B-A)
        Dim strRecordSeparator As String            'Permet de séparer les deux valeurs de la combinaison dans
        Dim xlCurrentCalculation As XlCalculation   'Stocke le mode de calcul actif
        Dim strBufferArray() As String              'Tableau de deux valeurs dans lequel on stocke les deux éléments constituant une combinaison
        Dim i As Long                               'Itérateur de boucle
        Dim j As Long                               'Itérateur de boucle
     
     
        With ActiveSheet
            'Le bloc de code suivant permet d'extraire toutes les valeurs uniques de la première colonne, qui sont stockées dans le dictionnaire objBufferDictionary
            lngLastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
            Set objBufferDictionary = CreateObject("SCRIPTING.DICTIONARY")
            For i = lngFIRSTROW To lngLastRow
                strCellValue = CStr(.Cells(i, 1))
                If Not objBufferDictionary.Exists(strCellValue) Then
                    objBufferDictionary.Add strCellValue, strCellValue
                End If
            Next i
     
            'Le bloc de code suivant génère les combinaisons uniques de valeurs de l'objet objBufferDictionary avec lui-même. Les résultats sont ensuite stockés dans l'objet objResultDictionary
            Set objResultDictionary = CreateObject("SCRIPTING.DICTIONARY")
            strRecordSeparator = Chr(30)
            For i = 0 To objBufferDictionary.Count - 1
                 For j = 0 To objBufferDictionary.Count - 1
                    'NB : On évalue les combinaisons dans les deux sens. Par exemple, si on a déjà la combinaison A-B, on ne stocke pas la combinaison B-A
                    strBufferValue_1 = objBufferDictionary.items()(i) & strRecordSeparator & objBufferDictionary.items()(j)
                    strBufferValue_2 = objBufferDictionary.items()(j) & strRecordSeparator & objBufferDictionary.items()(i)
                    If Not objResultDictionary.Exists(strBufferValue_1) And Not objResultDictionary.Exists(strBufferValue_2) Then
                        objResultDictionary.Add strBufferValue_1, strBufferValue_1
                    End If
                 Next j
            Next i
            Set objBufferDictionary = Nothing
     
            'Enfin, on restitue le résultat sur la feuille de calcul : les combinaisons uniques sont scindées de manière à récupérer les deux valeurs les constituant et sont inscrites sur l'onglet actif
            xlCurrentCalculation = Application.Calculation
            Application.Calculation = xlCalculationManual
            For i = 0 To objResultDictionary.Count - 1
                strBufferArray = Split(objResultDictionary.items()(i), strRecordSeparator)
                .Cells(i + 1, 2) = strBufferArray(0)
                .Cells(i + 1, 3) = strBufferArray(1)
            Next i
            Set objResultDictionary = Nothing
            Application.Calculation = xlCurrentCalculation
        End With
    End Sub

  4. #4
    Membre à l'essai
    Homme Profil pro
    Architecte technique
    Inscrit en
    Mai 2017
    Messages
    4
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Loiret (Centre)

    Informations professionnelles :
    Activité : Architecte technique
    Secteur : Administration - Collectivité locale

    Informations forums :
    Inscription : Mai 2017
    Messages : 4
    Par défaut
    Merci beaucoup.
    Ton code fonctionne parfaitement et répond exactement à mon besoin.
    Merci encore pour ton aide.

  5. #5
    Expert confirmé
    Homme Profil pro
    Inscrit en
    Août 2010
    Messages
    3 453
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : Août 2010
    Messages : 3 453
    Par défaut
    Re,

    Lequel de code ? car le résultat est légèrement différent !

  6. #6
    Membre à l'essai
    Homme Profil pro
    Architecte technique
    Inscrit en
    Mai 2017
    Messages
    4
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Loiret (Centre)

    Informations professionnelles :
    Activité : Architecte technique
    Secteur : Administration - Collectivité locale

    Informations forums :
    Inscription : Mai 2017
    Messages : 4
    Par défaut
    Ton code Theze me donne le résultat que j'attendais.
    Merci encore pour ton aide.

    Merci également Mr poulpe.

  7. #7
    Expert confirmé
    Homme Profil pro
    Inscrit en
    Août 2010
    Messages
    3 453
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : Août 2010
    Messages : 3 453
    Par défaut
    Bonjour,

    Merci de ta réponse, j'avais donc bien compris la demande

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

Discussions similaires

  1. Réponses: 0
    Dernier message: 16/09/2008, 13h28
  2. [VBA-E] Liste sans doublons pour remplir cellule
    Par Currahee dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 26/06/2007, 11h45
  3. Macro Excel VBA : création automatique de 140 graphes/graphiques
    Par techneric dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 11/02/2007, 10h13
  4. macro excel vba
    Par fildupa dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 20/12/2006, 21h29

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