Création tableau avec plusieus clients

Rosees

XLDnaute Nouveau
Bonjour,

En pièce-jointe veullez trouver mon fichier ainsi que la macro qui va avec.
Ce que j'aimerais réaliser :
A partir de mon premier tableau dans l'onglet "Référence", j'aimerais arriver au deuxième (objectif).
C'est-à-dire que je voudrais une seule ligne par client (avec la formule CONCATENER), et j'aimerais que la colonne Qté IT soit la somme de tous les IT pour lesquels la colonne A ne vaut pas 0.

Merci beaucoup !
 

Pièces jointes

  • Forum.xlsm
    23 KB · Affichages: 67
  • Forum.xlsm
    23 KB · Affichages: 69
  • Forum.xlsm
    23 KB · Affichages: 72

Rosees

XLDnaute Nouveau
Re : Création tableau avec plusieus clients

Oui je connais les TCD, très pratique dans certains cas mais cela ne correspond pas du tout à mes besoins actuels malheureusement.
Je suis sur cette macro depuis presque 24h je vais devenir complétement fou :D
Plus sérieusement, si tu trouves une solution je t'en serais infiniment reconnaissant :)
 

Dranreb

XLDnaute Barbatruc
Re : Création tableau avec plusieus clients

Bonjoour
Écoutez ne vous affolez pas. Il y a une méthode pour gérer ce qu'on appelle des ruptures de séquence.
On commence par mettre des Do:. On en met autant qu'il y a d'arguments + 1 pour le détail. Donc 2 dans votre cas puisqu'il n'y a qu'un argument. Ça donne à peu près ça ce brouillon :
VB:
Do: ' Début client
' réfléchir à ce qu'il y a lieu de faire quand on rencontre un nouveau client,
' ce qui est d'ailleurs le cas lors du 1er passage dans la boucle.
   Do: ' Détail
      ' réfléchir à ce qu'il y a lieu de faire avec toute liqne rencontrée.
      If CasFinal Then Exit Do ' voir quel est ce cas final.
      ' C'est là qu'on incrémente la ligne
      Loop Until Quoi ' Quoi ? Ben si le client de la nouvelle ligne n'est plus celui en cours.
   ' Fin client
   ' réfléchir à ce qu'il y a lieu de faire lorsqu'on sait maintenant qu'il _
       n'y aura plus d'autre ligne pour le client en cours.
    Loop Until CasFinal ' Tiens ! comme par hasard on retombe sur celui là !
Après on réfléchit et on complète…
 
Dernière édition:

Yohan

XLDnaute Occasionnel
Re : Création tableau avec plusieus clients

bon j'ai lu ta macro et elle est un peu blizzard puisque tu fait par exemple un while et tu testes une case que tu ne remplies jamais grâce à ta macro et qui est sur ta feuille que tu viens de crée.

Peux tu décrire plus précisément ce que doit faire la macro SVP
 

Rosees

XLDnaute Nouveau
Re : Création tableau avec plusieus clients

bon j'ai lu ta macro et elle est un peu blizzard puisque tu fait par exemple un while et tu testes une case que tu ne remplies jamais grâce à ta macro et qui est sur ta feuille que tu viens de crée.

Peux tu décrire plus précisément ce que doit faire la macro SVP

Ma macro doit créer un nouvel onglet et créer le même tableau "Objectif" que sur l'onglet "Référence". Ma macroi doit également être capable de calculer automatiquement les sommes des Qtés IT et des Qté IU. Pour finir, je ne dois avoir qu'une seule ligne par client.
Suis-je réellement loin de la solution?

Edit : De quelles cases parle tu?
Je ne teste que des cases du fichier "source" (ws1) non?
 

homepyrof53

XLDnaute Occasionnel
Re : Création tableau avec plusieus clients

Bonjour,

Voici une autre macro

Code:
Sub essai()
Dim Code_client, L1
 
Dim Tab_client
Set Tab_client = CreateObject("scripting.dictionary")
'--------------------------------
'  lecture des données
'--------------------------------
L1 = 4
While Cells(L1, 2) <> ""
    Code_client = Trim(Cells(L1, 2))
    If Tab_client.exists(Code_client) Then
        tmp = Tab_client(Code_client)
        tmp(1) = tmp(1) + Cells(L1, 8)
        tmp(2) = tmp(2) + Cells(L1, 9)
        Tab_client(Code_client) = tmp
    Else
        Tab_client(Code_client) = Array(Cells(L1, 3), Cells(L1, 8), Cells(L1, 9))
    End If
    L1 = L1 + 1
Wend

'--------------------------------
'  ecriture resultats
'--------------------------------
L1 = 26
For Each Code_client In Tab_client
    Cells(L1, 2) = Code_client ' numéro client
    Cells(L1, 3) = Tab_client(Code_client)(0) ' Nom client
    Cells(L1, 4) = Tab_client(Code_client)(1) ' Qte IT
    Cells(L1, 6) = Tab_client(Code_client)(2) ' Qte IU
    L1 = L1 + 1
Next

End Sub
 

homepyrof53

XLDnaute Occasionnel
Re : Création tableau avec plusieus clients

Ce que tu souhaites c'est de récupérer les totaux IT et IU pour chaque client.

Dans la partie lecture
Je parcours les lignes du premiers tableaux (jusqu’à première ligne vide)

pour chaque ligne on récupère le code client qui va être la "cle" du tableau et on y stock le nom du client le cumul It et le cumul IU (utilisation de l'array)

Si la cle existe (seconde ligne d'un client) on ajoute les valeurs IT et IU aux valeurs stockées

Après avoir complété ce tableau reste à écrie les résultats

pour chaque "cle" dans le tableau on écrit la cle le nom du client et les totaux IT et IY

Voilà
 

Rosees

XLDnaute Nouveau
Re : Création tableau avec plusieus clients

Cela ne marche toujours pas..

Voici mon code "adapté" :

Code:
Sub extract()
Dim Code_client, L1
 
Dim Tab_client
Set Tab_client = CreateObject("scripting.dictionary")

' feuille des clients
Set ws1 = Worksheets("Référence")
' numéro de client en cours
Set ws2 = Worksheets.Add 'crée un nouvel onglet
Set ws2 = Worksheets("Récapitulatif")
ws2.Name = ("Récapitulatif") 'nomme l'onglet

Sheets("Récapitulatif").Activate
 Rows("3:3").Select
    Selection.Copy
    Sheets("Référence").Activate
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Columns("G:G").Delete Shift:=xlToLeft
    Columns("G:G").Delete Shift:=xlToLeft
    Columns("G:G").Delete Shift:=xlToLeft
    Range("A1").Select
    ActiveCell.Value = ("Applicant / Donneur d'ordre")
    Range("B1").Select
    ActiveCell.Value = ("Applicant name : Nom du donneur d'ordre")
    Range("C1").Select
    ActiveCell.Value = ("Qty IP Trunk / Qté IP Trunk")
    Range("D1").Select
    ActiveCell.Value = ("Service IP Trunk")
    Range("D2").Value = ("3EY98995AA")
    Range("D3").Value = ("3EY98995AA")
    Range("E1").Select
    ActiveCell.Value = ("Qty IP Users / Qté IP Users")
    Range("F1").Select
    ActiveCell.Value = ("Service IP Users")
    Range("F2").Value = ("3EY98994AA")
    Range("F3").Value = ("3EY98994AA")
Set ws1 = Nothing
Set ws2 = Nothing

Sheets("Récapitulatif").Activate
'--------------------------------
'  lecture des données
'--------------------------------
L1 = 4
While Cells(L1, 2) <> ""
    Code_client = Trim(Cells(L1, 2))
    If Tab_client.exists(Code_client) Then
        tmp = Tab_client(Code_client)
        tmp(1) = tmp(1) + Cells(L1, 8)
        tmp(2) = tmp(2) + Cells(L1, 9)
        Tab_client(Code_client) = tmp
    Else
        Tab_client(Code_client) = Array(Cells(L1, 3), Cells(L1, 8), Cells(L1, 9))
    End If
    L1 = L1 + 1
Wend

Sheets("Référence").Activate
'--------------------------------
'  ecriture resultats
'--------------------------------
L1 = 26
For Each Code_client In Tab_client
    Cells(L1, 2) = Code_client ' numéro client
    Cells(L1, 3) = Tab_client(Code_client)(0) ' Nom client
    Cells(L1, 4) = Tab_client(Code_client)(1) ' Qte IT
    Cells(L1, 6) = Tab_client(Code_client)(2) ' Qte IU
    L1 = L1 + 1
Next
End Sub
 

homepyrof53

XLDnaute Occasionnel
Re : Création tableau avec plusieus clients

J'ai fini par comprendre ton problème
voila le code
Code:
Sub extract()
Application.Calculation = xlCalculationManual
Dim Code_client, L1
Dim Tab_client
Set Tab_client = CreateObject("scripting.dictionary")
'--------------------------------
'  lecture des données
'--------------------------------
Sheets("Référence").Activate
L1 = 4
While Cells(L1, 2) <> ""
    Code_client = Trim(Cells(L1, 2))
    If Tab_client.exists(Code_client) Then
        tmp = Tab_client(Code_client)
        tmp(1) = tmp(1) + Cells(L1, 8)
        tmp(2) = tmp(2) + Cells(L1, 9)
        Tab_client(Code_client) = tmp
    Else
        Tab_client(Code_client) = Array(Cells(L1, 3), Cells(L1, 8), Cells(L1, 9))
    End If
    L1 = L1 + 1
Wend
'--------------------------------
'  ecriture resultats
'--------------------------------
Sheets("Récapitulatif").Activate
Cells(1, 1) = ("Applicant / Donneur d'ordre")
Cells(1, 2) = ("Applicant name : Nom du donneur d'ordre")
Cells(1, 3) = ("Qty IP Trunk / Qté IP Trunk")
Cells(1, 4) = ("Service IP Trunk")
Cells(1, 5) = ("Qty IP Users / Qté IP Users")
Cells(1, 6) = ("Service IP Users")

Rows("2:65000").Delete Shift:=xlUp

L1 = 2
For Each Code_client In Tab_client
    Cells(L1, 1) = Code_client ' numéro client
    Cells(L1, 2) = Tab_client(Code_client)(0) ' Nom client
    Cells(L1, 3) = Tab_client(Code_client)(1) ' Qte IT
    Cells(L1, 4) = ("3EY98994AA")
    Cells(L1, 5) = Tab_client(Code_client)(2) ' Qte IU
    Cells(L1, 6) = ("3EY98994AA")
    L1 = L1 + 1
Next
Application.Calculation = xlCalculationAutomatic
End Sub
 

Discussions similaires