Discussion :

[aziz1015]

Bonjour, 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

Grâce à l'aide Tauthème, j'ai obtenu ce code :

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
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

il permet de rassembler toutes les lignes contenant plusieurs occurences. Le hic, c'est qu'il met trop temps (Bizarre, vu qu'il n'utilise que les tableaux), je l'ai lancé depuis 15h52, il est 16h54 et je n'ai toujours pas de réponses !
Mon but est de créer des périmètres (un ou plusieurs pour chaque groupe d'entreprises) ! Joe m'a alors suggéré de créer des classeurs par groupe avant de faire le traitement à l'aide d'un clic !

J'ai créé une macro qui créé un classeur qui fait un filtre sur la valeur de la cellule lorsqu'on clique sur un élément de la colonne "groupe" et créé un nouveau classeur ! Premier hic : la fonction ne me copie pas toutes les lignes, je ne comprends vraiment pas pourquoi ? le code ci-dessous :

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
Dim WsCible As Worksheet
Dim WsSOurce As Worksheet
 
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
 
Nbl = WsSOurce.Range("E1").CurrentRegion.Rows.Count
 
If Not Intersect(Target, Range("E1:E" & Nbl)) Is Nothing Then
 
    If FeuilleExiste(Target.Value) Then
        MsgBox ("La feuille associée à ce groupe existe déjà")
    Else
        Set WsCible = ThisWorkbook.Sheets.Add(After:=WsSOurce)
        WsCible.Name = Target.Value
        Nbl1 = WsCible.Range("A1").CurrentRegion.Rows.Count
 
    End If
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("A1")
    filtre.Close False
    Set filtre = Nothing
 
Application.ScreenUpdating = True
 
End If
End Sub

Merci d'avance pour votre aide !

[Marc-L]

Bonjour !

Pour comprendre c'est simple : suivre la progression du code en mode pas à pas via la touche F8
(ou en plaçant judicieusement des points d'arrêt) tout en contrôlant le contenu de la fenêtre des Variables locales …


_____________________________________________________________________________________________________
Je suis Charlie, Bardo, Sousse

[aziz1015]

Bonjour,

Merci pour votre réponse mais je l'ai déjà fait et je ne vois pas comment changer, j'ai oublié de vous préciser que mon onglet compte plus de 130 000 lignes et il fonctionne seulement le temps d'exécution est relativement long, au moins 30 minutes, ce qui n'est pas normal vu que le traitement se fait sur les tableaux !

Cordialement

[Marc-L]

Afin de comprendre, pas d'autre voie …

Sinon est-ce si difficile de penser à créer un fichier test de taille raisonnable ?!
On ne le fera pas à ta place …

Qui plus est tu as plusieurs discussions en cours pour le même sujet !
Un problème par discussion et attendre qu'il soit réglé avant de créer une nouvelle discussion …

_____________________________________________________________________________________________________
Long est le chemin de la connaissance …

[clementmarcotte]

Bonjour,

Bonjour,

ce qui n'est pas normal vu que le traitement se fait sur les tableaux !

Cordialement

Ça c'est vite dit que ce n'est pas normal. Excel a besoin de tout le classeur en mémoire vive pour travailler. Travailler avec des tableaux bouffe énormément de mémoire vive. Pour peu que ta mémoire vive soit encombrée, Windows doit passer "énormément" de temps à trouver de la mémoire pour Excel. Et puis, si tu as un Windows 32 bits, il ne peut gérer que 2 giga octets de mémoire vive.

Et puis VBA est interprété et non compilé. Cela veut dire que chaque ligne de code doit être traduite en langage-machine à chaque exécution de la ligne.

Excel est peut-être un bien beau programme mais ce n'est pas un SGBD, cela n'a jamais été un SGBD et ce ne sera jamais un SGBD.

On peut sans doute réussir à planter un clou tapant dessus avec un tournevis, ou demander à un psychiatre d'opérer sur une jambe cassée, mais cela ne garantit pas un résultat optimal.

[Thautheme]

Bonjour à tous,

On peut sans doute réussir à planter un clou tapant dessus avec un tournevis, ou demander à un psychiatre d'opérer sur une jambe cassée, mais cela ne garantit pas un résultat optimal.

Personnellement j'ai réussi à planté un clou avec un tournevis dans la jambe cassé d'un psychiatre... Arf ! Promis je ne le ferai plus... (c'est pas vrai, je le referai...)