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 :

Second tableau avec occurence distincte et liste de champs


Sujet :

Macros et VBA Excel

  1. #1
    Inactif  

    Profil pro
    Inscrit en
    Janvier 2011
    Messages
    3 064
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : Janvier 2011
    Messages : 3 064
    Points : 4 604
    Points
    4 604
    Par défaut Second tableau avec occurence distincte et liste de champs
    Bonsoir ,

    J'ai un tableau excel qui est mis à jour toutes les nuits par un batch.

    Ce tableau comporte 2 colonnes :

    1 colonne avec un id client , 1 colonne avec le service vendu

    Exemple :

    client1;service1
    client1;service3
    client2;service1
    client2;service2
    client2;service4
    client3;service3
    client3;service4
    client4;service5
    client5;service2
    client5;service3

    Je souhaite que ceci me génère un nouvelle liste comme ceci :

    client1;service1-service3-
    client2;service1-service2-service4-
    client3;service3 -service4-
    client4;service5-
    client5;service2-service3-
    ...

    Pour cela il faut que le programme fasse :
    - affecter l'id client dans un second tableau , si l'id client est déjà présent ne pas le réaffecté
    - parcourir le tableau1 à l'aide du tableau 2
    - on va comparer chaque cellule de l'id du tableau 1 à chaque la cellule de l'id du tableau 2
    - si l'id de t1 = id de t2 j'affecte à une cellule dans une seconde colonne du tableau 2 la chaine présente dans la seconde colonne du tableau 1 , on renouvelle l'opération , si l'id de t1 = id de t2 on va maintenant concaténer la chaine qui contiendra le mot serviceX , si serviceX est déjà présent on affecte la valeur déjà existant avec la nouvelle

    La liste doit se trouver comme ceci :

    A1 = entête de l'id client du tableau 1
    B1 = entête de la colonne du service vendu
    reste de la colonne A = id client
    reste de la colonne B = numéro du service vendu au client
    colonne C = colonne vide

    La liste résultat doit être comme ceci :

    colonne D = colonne avec les id client distinct
    colonne E = colonne avec les numéros de services vendu concaténés

    Voici le programme :

    Code VBA : 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
    56
    57
    58
    59
    60
    61
    62
    63
    64
     
    Option Explicit
    Option Base 0
    Sub listing()
     
    Dim n1 As Integer, n2 As Integer, n3 As Integer, n4 As Integer, n5 As Integer, n6 As Integer, n7 As Integer, n8 As Integer, n9 As Integer, n10 As Integer
    Dim compt1 As Integer, compt2 As Integer, compt3 As Integer, compt4 As Integer
    Dim c1 As String, c2 As String, c3 As String, c4 As String, c5 As String, c6 As String, c7 As String, c8 As String
     
    ' ActiveWorkbook.ActiveSheet.Cells(XXXX, XXXX).Values fait réference à la cellule active , c'est à dire la cellule ou se trouve le pointeur du programme VB dans la feuille de classeur Excel
     
    n1 = Range("BXXXX:BXXXX").End(xlUp).Row 'nombre de lignes à définir
    n3 = 1 ' ici n3= indice colonne 1
     
    c1(XXXX) = ActiveWorkbook.ActiveSheet.Cells(XXXX, XXXX).Values 'ligne X= premier ou deuxieme ligne du tableau a voir pr num
     
    For n2 = XX To n1 ' boucle for n2 de 1 à la valeur de n1 = nb de ligne + ligne de départ à trouver
     
    If c1(n2 - 1) <> ActiveWorkbook.ActiveSheet.Cells(X, XXXX).Values Then ' ligne X= premier ou deuxieme ligne du tableau a voir pr num , si ligne du dessus identique ligne active
     
    c1(n2, n3) = ActiveWorkbook.ActiveSheet.Cells(X, XXXX).Values  'ligne X= premier ou deuxieme ligne du tableau a voir pr num
     
    Else: c1(n2 - 1) = ActiveWorkbook.ActiveSheet.Cells(X, XXXX).Values
     
    End If
     
    Next
     
    n4 = 2 ' ici n4= indice colonne 2
     
    For n2 = XX To n1 ' boucle for n2 de 1 à la valeur de n1 = nb de ligne
     
    For n2 = XX To n1 ' boucle for n2 de 1 à la valeur de n1 = nb de ligne
     
    If ActiveWorkbook.ActiveSheet.Cells(X, XXXX).Values = c1(n2, n3) Then 'voir pour referencement cellule active colonne 1 et colonne 2
     
    n6 = Len(c2) 'longueur de chaine c2
     
    n5 = Len(ActiveWorkbook.ActiveSheet.Cells(X, XXXX).Values) ' preciser colonne 2 ou valeur texte a calculer longueur chaine
     
    c2 = ActiveWorkbook.ActiveSheet.Cells(X, XXXX).Values & "-" ' concatener valeur de colone 2 et le tiret
     
    n7 = n5 + n6 'longueur concatenation chaine
     
    c1(n2, n4) = c1(n2, n4) & c2 'concatenantion de valeur deja existante dans colonne 2 de c1 et ajout d'une nouvelle valeur  à la chaine
     
    End If
     
    Next
    Next
     
    For n2 = XX To n1
     
    ActiveWorkbook.ActiveSheet.Cells(XXXX, XXXX) = c1(n2, n3) ' voir affichage dans cellule
     
    MsgBox = Range("E" & n2)
     
    ActiveWorkbook.ActiveSheet.Cells(XXXX, XXXX) = c1(n2, n3) ' voir affichage dans cellule
     
    MsgBox = Range("F" & n2)
     
    Next
     
    End Sub

    Merci de m'aiguiller , je m'arrache les cheveux pour faire marcher ce programme

  2. #2
    Expert éminent sénior Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Points : 31 877
    Points
    31 877
    Par défaut
    Exemple basique à adapter

    données en Feuil1 et résultat en Feuil2
    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
    Sub Formation()
    Dim LastLig As Long, i As Long
     
    Application.ScreenUpdating = False
    'On copie les données vers la feuille Feuil2
    With Worksheets("Feuil1")
        LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("A1:B" & LastLig).Copy Worksheets("Feuil2").Range("A1")
    End With
     
     
    With Worksheets("Feuil2")
    'On tri les données sur la première et seconde colonne
        .Range("A1:B" & LastLig).Sort Key1:=.Range("A1"), Order1:=xlAscending, key2:=.Range("B1"), order2:=xlAscending, Header:=xlYes
     
        For i = LastLig To 3 Step -1
            If .Range("A" & i) = .Range("A" & i - 1) Then
                .Range("B" & i - 1) = .Range("B" & i - 1) & " - " & .Range("B" & i)
                .Rows(i).Delete
            End If
        Next i
    End With
    End Sub
    Sinon, si beaucoup de données on pourra utiliser un dictionnaire mais c'est du niveau un peu plus poussé
    Cordialement.
    J'utilise toujours le point comme séparateur décimal dans mes tests.

  3. #3
    Expert éminent sénior
    Avatar de Marc-L
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Avril 2013
    Messages
    9 468
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hauts de Seine (Île de France)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Avril 2013
    Messages : 9 468
    Points : 18 677
    Points
    18 677
    Par défaut
    Bonjour tanaka59,

    l'algorithme présenté est logique mais il y a plus simple et plus rapide !
    En complément du code de mercatog, en voici deux autres !

    La première démonstration utilise les fonctions de feuilles de calculs EQUIV (Match en VBA) et INDEX :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    Sub Demo1()
                             VA = [A1].CurrentRegion.Value:  ReDim RC$(1 To UBound(VA) - 1, 1 To 2)
        For R& = 2 To UBound(VA)
            V = Application.Match(VA(R, 1), Application.Index(RC, , 1), 0)
            If IsError(V) Then L& = L& + 1: RC(L, 1) = VA(R, 1): V = L
            RC(V, 2) = RC(V, 2) & VA(R, 2) & "-"
        Next
                  [D2:E2].Resize(L).Value = RC
        End
    End Sub
    La seconde fonctionne uniquement sous Windows à cause du dictionnaire évoqué par mercatog :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    Sub Demo2()
        With CreateObject("Scripting.Dictionary")
            VA = [A1].CurrentRegion.Value
            For R& = 2 To UBound(VA):  .Item(VA(R, 1)) = .Item(VA(R, 1)) & VA(R, 2) & "-":  Next
            [D2:E2].Resize(.Count).Value = Application.Transpose(Array(.Keys, .Items))
            .RemoveAll
        End With
        End
    End Sub
    __________________________________________________________________________________________

    Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …
    C'est parce que la vitesse de la lumière est plus rapide que celle du son que tant de gens paressent brillants avant d'avoir l'air con ! (Thomas Boishardy)

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

Discussions similaires

  1. [AJAX] Lier une liste avec un tableau avec Ajax
    Par hakou08 dans le forum AJAX
    Réponses: 4
    Dernier message: 03/04/2009, 11h53
  2. Tableau avec listes déroulantes(récupération de chaque selection faite)
    Par claire63 dans le forum Général JavaScript
    Réponses: 2
    Dernier message: 07/01/2008, 18h27
  3. Réponses: 7
    Dernier message: 22/09/2006, 16h52
  4. [Excel]Ouvrir un tableau avec une liste modifiable
    Par mulot03 dans le forum Macros et VBA Excel
    Réponses: 8
    Dernier message: 04/05/2006, 10h52
  5. Valoriser un tableau avec le resultat d'une liste multiple
    Par christophe_j dans le forum Général JavaScript
    Réponses: 5
    Dernier message: 17/11/2005, 12h01

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