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