Problème Classer des données excel VBA

Version imprimable

07/08/2015, 14h05
aziz1015

Problème Classer des données excel VBA

Bonjour,

Je dispose d'un classeur Excel dans lequel je dois regrouper les lignes du classeur selon des conditions sur les colonnes. Par exemple :

1 - je prends la première ligne du fichier

2 - je compare les éléments de colonnes suivants : le prix, le libelle, le code client

3 - s'ils sont égaux, j'assemble toutes les lignes ensemble ensuite, je décale deux lignes et je recommence

J'espère avoir été clair ! Mon problème est que le classeur compte plus de 130 000 lignes, si chaque ligne doit être comparé aux 123 000 autres lignes, je pense que je ne m'en sortirai pas ! Je viens humblement vous demander de l'aide ( des idées, des exemples déjà traités), pourrait-il avoir un autre moyen sans passer par du VBA par exemple ?

Merci d'avance pour votre aide
07/08/2015, 16h22
joe.levrai

Bonjour,

je n'ai pas tout compris :

1) On la première ligne : OK
2) On regarde dans les autres lignes si le trio [le prix, le libelle, le code client] est identique
3) Tu entends quoi par "assembler" ??

Ne voudrais-tu pas, par hasard, trier tes 130 000 lignes afin que toutes les lignes ayant [le prix, le libelle, le code client] identiques soient disposés à la suite sur ta feuille ... et en séparant chaque "tas" par 2 lignes ?
07/08/2015, 16h41
aziz1015

Citation:

Envoyé par joe.levrai

Ne voudrais-tu pas, par hasard, trier tes 130 000 lignes afin que toutes les lignes ayant [le prix, le libelle, le code client] identiques soient disposés à la suite sur ta feuille ... et en séparant chaque "tas" par 2 lignes ?

Bonjour joe,

Vous avez encore une fois compris le problème mieux que moi même !

Je souhaite en effet que toutes les lignes identiques soient disposées à la suite dans un autre onglet, en séparant chaque tas par des lignes ! J'ai oublié de préciser qu'on ne passe pas à la comparaison de ces trois colonnes (prix, libelle et code client) si et seulement si le nom du groupe est le même.

Le but est de regrouper toutes les lignes ayant [le prix, le libelle, le code client] identiques pour chaque groupe pour établir en quelque sorte "un périmètre" !

Je souhaite faire ceci dans un autre onglet parce que je voudrais après(quand j'aurai fini le regroupement) ajouter des boutons qui permettront à l'utilisateur d'ajouter ou supprimer des lignes dans un périmètre en se servant de la base de départ !

Merci pour votre aide

Bonjour le fil, bonjour le forum,

Juste avant de réponde je viens de rafraîchir le post et je vois qu'il y a une nouvelle condition de groupe que ne gère pas le code que je te propose. Je vois aussi que Joe a vu juste et qu'un simple tri pourrait suffire...

Il te faudra adapter le(s) code(s) ci-dessous car tu ne précises pas quelles sont les colonnes qui contiennent le Code Client, le Libellé et le prix (et le groupe).
• La Macro1 ne rassemble que les élément contenant plusieurs occurrences.
• La Macro2 rassemble toutes les lignes...
Code commenté :

Code:

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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
Private OS As Worksheet 'déclare la variable OS (Onglet Source)
Private OD As Worksheet 'déclare la variable OD (Onglet Destination)
Private TC As Variant 'déclare la variable TC (Tableau de Cellules)
Private NL As Long 'déclare la variable NL (Nombre de Lignes)
Private NC As Integer 'déclare la variable NC (Nombre de Colonnes)
 
Sub Macro1()
Dim D As Object 'déclare la variable ND (Dictionnaire)
Dim CC As String 'déclare la variable CC (Concaténation de Colonnes)
Dim TL() As Variant 'déclare la variable TL (Tableai de Lignes)
Dim I As Long 'déclare la variable I (Incrément de lignes)
Dim J As Integer 'déclare la variable J (incrément de lignes)
Dim K As Long 'déclare la variable K (incrément de lignes)
Dim L As Integer 'déclare la variable L (incrément de colonnes)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
 
Set OS = Sheets("Feuil1") 'définit l'onglet source OS (à adapter)
Set OD = Sheets("Feuil2") 'définit l'onglet destination OD (à adapter)
TC = OS.Range("A1").CurrentRegion 'définit le tableau de cellules TC (à adapter)
NL = UBound(TC, 1) 'définit le nombre de lignes NL du tableau de cellulles TC
NC = UBound(TC, 2) 'définit le nombre de colonnes NC du tableau de cellulles TC
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionaire D
For I = 2 To NL 'boucle sur toutes les ligne du tableau de cellues TC (en partant de la seconde)
    'définit la concaténation CC
    'remplace 1, 2 et 3 par le numero des colonnec contenant le "Code Clien", le "Libellé" et le "Prix"
    CC = CStr(TC(I, 1)) & CStr(TC(I, 2)) & CStr(TC(I, 3))
    D(CC) = D(CC) + 1 'alimente le dictionnaire avec le concaténation CC
Next I 'prichaine ligne de la boucle
TE = D.keys 'récupère tableau TE (Tableau des Éléments) les éléments du dictionnaire D sabs doiblon
TOC = D.items 'récupère tableau TOC (Tableau des OCcurrences) le nombre d'occurrence de chaque élément de TE
For I = LBound(TE) To UBound(TE) 'boucle sur tous les éléments de TE
    If TOC(I) > 1 Then 'condition 1 : si l'élément a plusieurs occurrences
        K = 1 'initialise la variable K
        For J = 2 To NL 'boucle 1 sur toutes les lignes J du tableau de cellules TC (en partant de la seconde)
            'condition 2 : si la concaténation des colonne 1 deux et trois est égale à TE(I)
            'remplace 1, 2 et 3 par le numero des colonnec contenant le "Code Clien", le "Libellé" et le "Prix"
            If CStr(TC(J, 1)) & CStr(TC(J, 2)) & CStr(TC(J, 3)) = TE(I) Then
                'redimensionne le tableau de lignes TL (autant de ligne que TC a de colonnes,K colonnes)
                ReDim Preserve TL(1 To NC, 1 To K)
                For L = 1 To NC 'boucle 2 : sur toutes les colonnes de TC
                    TL(L, K) = TC(J, L) 'récupère dans la ligne de TL la valeur de la colonne de TC (transposition)
                Next L 'prochaine colonne de la boujcle 2
                K = K + 1 'incrémente K
            End If 'fin de la condition 2
        Next J 'prochaien ligne de la boucle 1
        If K > 1 Then 'condition 3 : si K est supérieur à 1 (au moins une occurrence trouvée)
            'définit la cellue de destination DEST
            Set DEST = IIf(OD.Range("A1").Value = "", OD.Range("A1"), OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(3, 0))
            'revoie dans DEST redinensionnée le tableau TL transposé
            DEST.Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
        End If 'fin de la condition 3
        Erase TL 'vide le tableau TL
    End If 'fin de la condition 1
Next I 'prochain élément du tableau TE
End Sub
 
Sub Macro2()
Dim D As Object 'déclare la variable ND (Dictionnaire)
Dim CC As String 'déclare la variable CC (Concaténation de Colonnes)
Dim TL() As Variant 'déclare la variable TL (Tableai de Lignes)
Dim I As Long 'déclare la variable I (Incrément de lignes)
Dim J As Integer 'déclare la variable J (incrément de lignes)
Dim K As Long 'déclare la variable K (incrément de lignes)
Dim L As Integer 'déclare la variable L (incrément de colonnes)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
 
Set OS = Sheets("Feuil1") 'définit l'onglet source OS (à adapter)
Set OD = Sheets("Feuil2") 'définit l'onglet destination OD (à adapter)
TC = OS.Range("A1").CurrentRegion 'définit le tableau de cellules TC (à adapter)
NL = UBound(TC, 1) 'définit le nombre de lignes NL du tableau de cellulles TC
NC = UBound(TC, 2) 'définit le nombre de colonnes NC du tableau de cellulles TC
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionaire D
For I = 2 To NL 'boucle sur toutes les ligne du tableau de cellues TC (en partant de la seconde)
    'définit la concaténation CC
    'remplace 1, 2 et 3 par le numero des colonnec contenant le "Code Clien", le "Libellé" et le "Prix"
    CC = CStr(TC(I, 1)) & CStr(TC(I, 2)) & CStr(TC(I, 3))
    D(CC) = D(CC) + 1 'alimente le dictionnaire avec le concaténation CC
Next I 'prichaine ligne de la boucle
TE = D.keys 'récupère tableau TE (Tableau des Éléments) les éléments du dictionnaire D sabs doiblon
For I = LBound(TE) To UBound(TE) 'boucle sur tous les éléments de TE
    K = 1 'initialise la variable K
    For J = 2 To NL 'boucle 1 sur toutes les lignes J du tableau de cellules TC (en partant de la seconde)
        'condition 1 : si la concaténation des colonne 1 deux et trois est égale à TE(I)
        'remplace 1, 2 et 3 par le numero des colonnec contenant le "Code Clien", le "Libellé" et le "Prix"
        If CStr(TC(J, 1)) & CStr(TC(J, 2)) & CStr(TC(J, 3)) = TE(I) Then
            'redimensionne le tableau de lignes TL (autant de ligne que TC a de colonnes,K colonnes)
            ReDim Preserve TL(1 To NC, 1 To K)
            For L = 1 To NC 'boucle 2 : sur toutes les colonnes de TC
                TL(L, K) = TC(J, L) 'récupère dans la ligne de TL la valeur de la colonne de TC (transposition)
            Next L 'prochaine colonne de la boujcle 2
            K = K + 1 'incrémente K
        End If 'fin de la condition 1
    Next J 'prochaien ligne de la boucle 1
    If K > 1 Then 'condition 2 : si K est supérieur à 1 (au moins une occurrence trouvée)
        'définit la cellue de destination DEST
        Set DEST = IIf(OD.Range("A1").Value = "", OD.Range("A1"), OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(3, 0))
        'revoie dans DEST redinensionnée le tableau TL transposé
        DEST.Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
    End If 'fin de la condition 2
    Erase TL 'vide le tableau TL
Next I 'prochain élément du tableau TE
End Sub

07/08/2015, 17h31
joe.levrai

Je te propose, suite à ta contrainte de groupe et d'avoir ça dans une nouvelle feuille, la proposition suivante :

- une feuille par groupe
- on fait nos regroupements de libellé/prix/code client
- plus besoin de séparer de deux lignes

Car le problème d'insérer deux lignes vides, c'est qu'il devient compliqué d'utiliser par la suite des outils de filtres (par exemple)
07/08/2015, 18h28
aziz1015

Citation:

Envoyé par Thautheme

Bonjour le fil, bonjour le forum,

Juste avant de réponde je viens de rafraîchir le post et je vois qu'il y a une nouvelle condition de groupe que ne gère pas le code que je te propose. Je vois aussi que Joe a vu juste et qu'un simple tri pourrait suffire...

Il te faudra adapter le(s) code(s) ci-dessous car tu ne précises pas quelles sont les colonnes qui contiennent le Code Client, le Libellé et le prix (et le groupe).
• La Macro1 ne rassemble que les élément contenant plusieurs occurrences.
• La Macro2 rassemble toutes les lignes...
Code commenté :

Merci infiniment Tauthème, je vais essayer de l'adapter et je vous reviendrai si j'ai un souci ! Merci

Citation:

Envoyé par joe.levrai

Je te propose, suite à ta contrainte de groupe et d'avoir ça dans une nouvelle feuille, la proposition suivante :

- une feuille par groupe
- on fait nos regroupements de libellé/prix/code client
- plus besoin de séparer de deux lignes

Car le problème d'insérer deux lignes vides, c'est qu'il devient compliqué d'utiliser par la suite des outils de filtres (par exemple)

J'avais carrément écarter l'option du filtre dès qu'on m'a fait comprendre qu'il fallait séparer les "périmètres" par des lignes !

Créer une feuille pour chaque groupe me paraît être la meilleure solution, cela rendrait l'ajout ou la suppression d'une ligne d'un groupe bien plus facile.

Le problème (je ne sais si c'en est vraiment un) est que le nombre de groupes est ou aussi important, dans ce cas, il va alors falloir pouvoir créer une sorte de "boîte de dialogues" avec le nom de tous les groupes (feuilles) permettant à l'utilisateur d'atteindre la feuille (le groupe) lorsqu'il clique sur un nom de feuille ?

Aussi, j'ai un autre problème, le fichier se plante déjà tout seul juste quand il reste ouvert assez longtemps (peut être parce qu'il a trop de données dans la feuille), créer d'autres feuilles n'aggraverait-il pas la solution ? Ou bien faudra t-il les mettre dans un autre classeur ?

Merci pour votre aide et votre disponibilité
07/08/2015, 18h38
joe.levrai

Je ne comprend pas bien tes dernières remarques

on peut changer notre fusil d'épaule !

1) on fait les regroupements
2) on ne sépare pas les tas avec deux lignes vides
3) un simple filtre automatique (voir avancé si tu veux exporter les données) te permettra de choisir un groupe ou plusieurs groupes si besoin
07/08/2015, 18h48
aziz1015

Citation:

Envoyé par joe.levrai

3) un simple filtre automatique (voir avancé si tu veux exporter les données) te permettra de choisir un groupe ou plusieurs groupes si besoin

Haa ok, je ne visualisais pas très bien ton idée, je vois mais du coup quand tu parlais de créer une feuille par groupe, tu ne parlais de mettre chaque groupe (périmètre) correspondant aux critères dans une feuille du classeur en faisant un filtre ?

Parce que si c'est bien le cas, je ne comprends pas bien ce que tu veux dire en 3), puisque chaque groupe se retrouvera dans une feuille, je ne vois pas comment un simple filtre automatique pourrait permettre d'en choisir plusieurs ! Un filtre ne se fait-il pas dans une feuille ? :aie::aie:
07/08/2015, 18h52
Thautheme

Re,

Aziz, As-tu regardé la proposition que je t'ai faite ? Je peux comprendre qu'elle ne convienne pas mais pas que tu l'ignores...
07/08/2015, 18h53
aziz1015

Désolé d'être lent à réagir !

Je ne l'ignore pas je t'ai répondu, j'ai dit que je travaille dessus et je reviendrai, je suis entrain de travailler sur le bout de code actuellement ! Par ailleurs, j'essaye aussi de comprendre l'idée de Joe !

;)
07/08/2015, 18h57
Thautheme

Re,

Désolé Aziz, je navet (dans ce cas on peut !) pas vu ta réponse... Je te prie de m'excuser.

1 pièce(s) jointe(s)

Il n y a aucun mal, merci pour ton aide, j'avais essayé cette idée en fait, j'avais créé une sorte de clé en concaténant les différentes conditions pour essayer de visualiser sous forme de TCD ! Un imprim écran :

Pièce jointe 184931

j'essayais d'abord de comprendre ton code, je n'avais pas encore compilé, j'ai un problème lorsque je l'exécute "Dépassement de capacité" ! J'ai passé que c'était du au nombre de ligne dépassant les 655... parce que l'erreur se situe :
Code:

1 2 3 4 5 For I = LBound(TE) To UBound(TE) 'boucle sur tous les éléments de TE If TOC(I) > 1 Then 'condition 1 : si l'élément a plusieurs occurrences K = 1 'initialise la variable K For J = 2 To NL 'boucle 1 sur toutes les lignes J du tableau de cellules TC (en partant de la seconde)
J'ai donc gardé 60 000 lignes dans mon onglet mais toujours la même erreur ! Je crois que ça ne doit pas vraiment être le problème parce qu'un autre parcours des lignes se fait avant cette étape ! :aie:

08/08/2015, 08h27
Theze

Bonjour,

Citation:

j'ai un problème lorsque je l'exécute "Dépassement de capacité"

C'est probablement une variable déclarée Integer qui ne peut aller au delà de 32767, il faut la typer Long.

Hervé.

Bonjour,

comme le souligne Theze, il y a un problème sur deux variables typée en Integer, qu'il faut typer en Long :

- variable NC
- variable J

par ailleurs, ici :
Code:

1 2 3 4 5 6 If K > 1 Then 'condition 3 : si K est supérieur à 1 (au moins une occurrence trouvée) 'définit la cellue de destination DEST Set DEST = IIf(OD.Range("A1").Value = "", OD.Range("A1"), OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(3, 0)) 'revoie dans DEST redinensionnée le tableau TL transposé DEST.Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) End If 'fin de la condition 3
il faut bien surveiller le nombre de ligne qu'on renvoie avec Transpose
au delà de 65535 le transpose va s'arrêter il me semble ... j'ai déjà eu le tour sur un autre sujet traité par le passé

je recherche le sujet en question

EDIT : voilà le sujet http://www.developpez.net/forums/d15...s/#post8259216

à partir de la ligne 54 de mon code, j'ai été obligé de découper mon Tableau par lot de 65535 éléments pour le restituer sur une feuille Excel via un Transpose

Citation:
Envoyé par joe.levrai
Code:

1 2 3 4 5 6 If K > 1 Then 'condition 3 : si K est supérieur à 1 (au moins une occurrence trouvée) 'définit la cellue de destination DEST Set DEST = IIf(OD.Range("A1").Value = "", OD.Range("A1"), OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(3, 0)) 'revoie dans DEST redinensionnée le tableau TL transposé DEST.Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) End If 'fin de la condition 3
à partir de la ligne 54 de mon code, j'ai été obligé de découper mon Tableau par lot de 65535 éléments pour le restituer sur une feuille Excel via un Transpose
Bonjour Joe, merci pour votre aide, j'ai réglé le problème en typant les Integer en Long ! Aussi avant de découper le tableau en utilisant la solution que tu as proposée, j'ai préféré essayer de travailler avec mois de 65000 lignes d'abord ! Le problème c'est que ça compile pendant plus de 30 minutes avant de donner un résultat ! Il n y aurait-il pas un moyen de rendre le programme plus rapide (l'optimiser) ?

09/08/2015, 12h40
joe.levrai

Bonjour,

c'est surprenant que la procédure proposée par Thautheme mette 30 minutes à réaliser ses actions 8O
il travaille dans des tableaux VBA et pas sur la feuille elle-même

si le fichier est vraiment trop lourd pour y ajouter des actions, on peut faire quelque chose comme ça :

1) Quand l'utilisateur active la feuille : un message lui propose de basculer en mode recherche
2) S'il dit OK : quand il fera un double clic sur une cellule de la colonne GROUPE, ça crée un nouveau classeur contenant toutes les données du groupe, avec le regroupement sur le libellé, code client et tarif

comme ça on ne crée rien dans ton gros classeur
Et on peut également ne récupérer qu'une partie des colonnes, si tu n'as pas besoin de tout montrer

il est tant de nous mettre un classeur exemple en copie, histoire de bien visualiser la structure ainsi que la position des colonnes qu'on doit manipuler
10/08/2015, 01h26
aziz1015

2 pièce(s) jointe(s)

Citation:

Envoyé par joe.levrai

si le fichier est vraiment trop lourd pour y ajouter des actions, on peut faire quelque chose comme ça :

1) Quand l'utilisateur active la feuille : un message lui propose de basculer en mode recherche
2) S'il dit OK : quand il fera un double clic sur une cellule de la colonne GROUPE, ça crée un nouveau classeur contenant toutes les données du groupe, avec le regroupement sur le libellé, code client et tarif

Désolé de ne répondre que maintenant, j'ai une très mauvaise connexion à la maison. En effet, votre proposition est très intéressante joe et permettra plus facilement la validation des périmètres je pense, je vous joins en imprim écran :

Pièce jointe 185002

Les colonnes qui nous intéressent sont : GROUPE SIREN(RAISON SOCIALE) et les conditions LIBELLE PVC, CODE GT, PRIX APPELE !

Dans l'imprim écran, j'ai fait un filtre sur le groupe pour que vous puissiez voir de quoi est composé un groupe !

Comme vous pourriez sur l'imprim écran, un "GROUPE" contient plusieurs "RAISONS SOCIALES" et chaque "RAISON SOCIALE" est associé à un SIREN (On peut dire que le groupe est le père et que les SIREN ou RAISON SOCIALE sont les enfants)! Juste pour le groupe "ALLAIN" par exemple, j'ai plus de 50 raisons sociales (filiales du groupe)

Le but est de regrouper les périmètres par groupe, c'est à dire, pour chaque groupe, regrouper tous les "SIREN" ou "RAISON SOCIALE" qui présentent à peu près les mêmes caractéristiques (LIBELLE PVC, CODE GT, PRIX APPELE)

Tout en suivant votre raisonnement Joe, il faudrait que :

Citation:

1) Quand l'utilisateur active la feuille : un message lui propose de basculer en mode recherche
2) S'il dit OK : quand il fera un double clic sur une cellule de la colonne GROUPE
3) Toutes les lignes avec les raisons sociales (SIREN) du groupe s'affichent (on affiche toutes les lignes du groupe) !
4) Quand on fait un double-clic sur une raison sociale, ça crée un nouveau classeur contenant toutes les données du groupe (rajoute des nouvelles données si le classeur du groupe existe déjà, parce que j'ai remarqué dans le résultat du code ), avec le regroupement sur les lignes où les libellés, codes GT et prix sont identiques !

Des exemples de périmètre :

Pièce jointe 185005

J'espère avoir été clair et vous avoir suivi dans votre raisonnement !

Merci d'avance pour votre aide

Bonjour Joe, Bonjour le forum,

En m'inspirant de votre idée, j'ai créé une macro qui crée une feuille selon le nom du groupe sur lequel on clique, j'intégrerai un if après pour gérer le cas où le nom du groupe sur lequel on clique existe déjà !

Code:

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
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 
Set WsSOurce = ThisWorkbook.Worksheets("RT_SANTE_FIC_COMPLETE")
On Error Resume Next: WsSOurce.ShowAllData: On Error GoTo 0
'Set Plage = Range("E2:E" & Range("E65536").End(xlUp).Row)
Nbl = WsSOurce.Range("E1").CurrentRegion.Rows.Count
 
If Not Intersect(Target, Range("E1:E" & Nbl)) Is Nothing Then
MsgBox Target.Value
Cancel = True
End If
 
'créer la feuille du groupe
Set WsCible = ThisWorkbook.Sheets.Add(After:=WsSOurce)
WsCible.Name = Target.Value
 
 
'faire le filtre sur le nom du groupe qui se trouve dans la cellule du double clic
 
Application.ScreenUpdating = False
    Set filtre = Workbooks.Add
    filtre.Sheets(1).Range("A1") = "GROUPE"
 
    filtre.Sheets(1).Range("A2") = Target.Value
    FiltreActif WsSOurce.UsedRange, filtre.Sheets(1).UsedRange, WsCible.Range("A" & Nbl1)
    filtre.Close False
    Set filtre = Nothing
'End If
Application.ScreenUpdating = True
End Sub

Merci d'avance pour votre aide