Discussion :

[KekeStreet]

Bonjour ,

Contexte : En ce moment je bosse sur un projet avec une base de donnée, et (hélas) on m'impose de travailler sous Excel et pas Access. Je tente donc d'implémenter des "bidules" de gestion de base de donnée sur excel.. ()

Le fichier se compose de plusieurs feuilles composées de listes d'arborescences d'ensembles de pièces. chaque pièces ou ensemble a un partNumber (numéro d'identification). une ligne represente une pièce ou un ensemble et dans les colonnes on retrouve des données relatives (partNumber, prix.. etc).

Comme on peut retrouver plusieurs fois la même pièce sur des lignes différentes, il me faut un moyen de synchroniser toutes les lignes qui ont le même partNumber, pour que lorsque je modifie une donnée d'une pièce, toutes les lignes de cette pièce soient modifiées. Les formules sont inutiles car se sont des liens et je dois pouvoir modifier de n'importe quel endroit.

Problème : j'ai façonné une petite macro mais elle prend du temps. lorsqu'on modifie cellule par cellule c'est (presque) fluide mais dès qu'on manipule des plages, sur des fichier de plusieurs milliers de ligne ça peut mettre 10 bonnes secondes (l'utilisateur lambda est impatient).

Je viens donc vous solliciter pour une amélioration du code, la priorité est la fluidité de l'execution mais si une simplification du code est possible ça m'interesse aussi.

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
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
103
104
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Synchro Sh, Target
End Sub
 
Private Sub Synchro(ByVal Sh As Object, ByVal Target As Range)
'Synchronise automatiquement toutes les lignes avec le même partNumber
'(Restriction aux colonnes 9 à 11)
 
    Dim areas() As String
    Dim partNumber As String
    Dim firstCol As Long
    Dim firstRow As Long
    Dim lastCol As Long
    Dim lastRow As Long
    Dim memory As String
 
'    Traitement séparé pour les sélections à plages multiples
    If InStr(Target.Address, ",") <> 0 Then
        areas = Split(Target.Address, ",")
        For i = 0 To UBound(areas)
            Synchro Sh, Range(areas(i))
        Next i
        Exit Sub
    End If
 
'    Détermination du type de plage puis délimitation du périmètre
    If InStr(Target.Address, ":") Then
        If Len(Target.Address) - Len(Replace(Target.Address, "$", "")) = 2 Then
            If IsNumeric(Mid(Target.Address, 2, 1)) Then
'                Une ou plusieurs lignes
                firstCol = 1
                lastCol = Sh.Cells(1, Columns.Count).End(xlToLeft).Column
                firstRow = Split(Replace(Target.Address, ":", ""), "$")(1)
                lastRow = Split(Replace(Target.Address, ":", ""), "$")(2)
            Else
'                Une ou plusieurs colonnes
                firstCol = Columns(Split(Replace(Target.Address, ":", ""), "$")(1)).Column
                lastCol = Columns(Split(Replace(Target.Address, ":", ""), "$")(2)).Column
                firstRow = 1
                lastRow = Sh.Cells(Rows.Count, 1).End(xlUp).Row
            End If
        Else
'            Plusieurs Cellules
            firstCol = Columns(Split(Target.Address, "$")(1)).Column
            lastCol = Columns(Split(Target.Address, "$")(3)).Column
            firstRow = Val(Split(Target.Address, "$")(2))
            lastRow = Val(Split(Target.Address, "$")(4))
        End If
    Else
'        Une seule cellule
        firstCol = Columns(Split(Target.Address, "$")(1)).Column
        lastCol = firstCol
        firstRow = Val(Split(Target.Address, "$")(2))
        lastRow = firstRow
    End If
 
'    Restrictions à la partie synchronisée du périmètre (colonnes 9 à 11, sauf ligne 1)
    If lastCol >= 9 Then firstCol = WorksheetFunction.Max(firstCol, 9) Else Exit Sub
    If firstCol <= 11 Then lastCol = WorksheetFunction.Min(lastCol, 11) Else Exit Sub
    If lastRow >= 2 Then firstRow = WorksheetFunction.Max(firstRow, 2) Else Exit Sub
    If firstRow <= Sh.Cells(Rows.Count, 1).End(xlUp).Row Then
        lastRow = WorksheetFunction.Min(lastRow, Sh.Cells(Rows.Count, 1).End(xlUp).Row)
    Else
        Exit Sub
    End If
 
'    Optimisation performances
    Application.Cursor = xlWait
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
'    Protection contre les instances multiples imbriquées
    Application.EnableEvents = False
 
'    Balayage du périmètre ligne par ligne
    memory = ""
    For thisRow = firstRow To lastRow
        partNumber = Sh.Cells(thisRow, 1)
 
        If partNumber <> "" Then
            If InStr(memory, partNumber & ",") = 0 Then
                memory = memory & partNumber & ","
 
'                Recherche feuille par feuille (s) et ligne par ligne (r)
                For s = 1 To Sheets.Count
                    For r = 1 To Sheets(s).Cells(Rows.Count, 1).End(xlUp).Row
                        If Sheets(s).Cells(r, 1) = partNumber Then
'                            Copie colonne par colonne (c)
                            For c = firstCol To lastCol
                                Sheets(s).Cells(r, c) = Sh.Cells(thisRow, c)
                            Next c
                        End If
                    Next r
                Next s
            End If
        End If
    Next thisRow
 
    Application.EnableEvents = True
 
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.Cursor = xlDefault
End Sub

J'ai découvert que c'est surtout lorsqu'une valeur doit être écrite que ça prend du temps, j'ai déjà utilisé quelques petites astuces comme : Application.ScreenUpdating = False & Application.Calculation = xlCalculationManual (30% de gain de vitesse) ainsi que l'utilisation de memory : empèche la macro de synchroniser un partNumber qui a déjà été synchronisé.

Je suis à court d'idées là.. merci déjà d'avoir lu cet atroce pavé.

[issoram]

Bonjour,

Travaille avec des tableaux plutôt que des plages, le gain de temps sera au minimum de x20.

Un tuto ici, l'intro très explicite te donne un exemple.

Cordialement.

[Oliv-]

Bonjour,
Travaille avec des tableaux plutôt que des plages, le gain de temps sera au minimum de x20.
...

Salut, regarde le fichier joint dans ce post tu y trouveras des exemples avec des tableaux, des dictionnaires, adodb etc...

[KekeStreet]

Oui j'ai déjà vu les magnifiques tutos sur les tableaux, le soucis est que je suis une bonne grosse bille en tableaux, dicos et autres subterfuges de cet acabit . Mais si il n'y a que cette solution, je crois bien que je vais m'y mettre plus sérieusement. Merci pour l'idée .

Bon, si j'ai bien compris je charge mes plages en memoire, dans des tableaux, je fais les changements que j'ai à faire sur ces tableau, et une fois fini j'écris tout d'un seul fois dans excel ?

[KekeStreet]

J'ai tenté deux-trois trucs à l'arrache mais sans succès :

Tout d'abord en ajoutant :

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
    Dim tmpWorkbook() As Variant
 
    '[...]
 
'    Charger les données dans le tableau
    ReDim tmpWorkbook(Sheets.Count, 2604, 9 To 11)
    For s = 1 To Sheets.Count
        For r = 1 To 2604
            For c = 9 To 11
                tmpWorkbook(s, r, c) = Worksheets(s).Cells(r, c).Value
            Next c
        Next r
    Next s
 
    '[...]
 
                                'Calculs en remplaçant
                                'Sheets(s).Cells(r, c) = Sh.Cells(thisRow, c)
                                'par :
                                tmpWorkbook(s, r, c) = tmpWorkbook(Sh.Index, thisRow, c)
 
    '[...]
 
'    Ecriture des données dans Excel
    For s = 1 To Sheets.Count
        For r = 1 To 2604
            For c = 9 To 11
                Worksheets(s).Cells(r, c).Value = tmpWorkbook(s, r, c)
            Next c
        Next r
    Next s
    Erase tmpWorkbook

ça marche mais perte de temps plutôt que gain.. ça doit pas être la bonne methode. d'ailleurs d'après ce que j'ai compris du lien que tu m'a passé Oliv-, le tableau devrait se remplir et s'écrire en 1 seul instruction pour qu'il y ait gain de temps, non ?

Après j'ai tenté un truc du style :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
    Dim tmpSheet1() As Variant
    Dim tmpSheet2() As Variant
 
    '[...]
 
'    Charger les données dans le tableau
    tmpSheet1 = Sheets(1).UsedRange
    tmpSheet2 = Sheets(2).UsedRange

Là j'ai carrément une erreur.. le tableau aime pas que je lui donne à manger du range apparemment.. j'ai pas du comprendre un truc . m'enfin je m'y attendais.. ça m'a fatigué et j'ai fais les choses vraiment à l'arrache alors je verrais plus clair demain.

[issoram]

Pour:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
    Dim tmpSheet1() As Variant
    Dim tmpSheet2() As Variant
 
'   Charger les données dans le tableau
    tmpSheet1 = Sheets(1).UsedRange
    tmpSheet2 = Sheets(2).UsedRange

C'est normal que tu aies une erreur, les variables doivent être de type variant tout court (pas un tableau de variant ce qui je te l'accorde semblerait logique). De plus comme tu le dis : "tu lui donnes du Range à bouffer", alors que ce sont simplement des valeurs dont tu as besoin.
En résumé ça donnerait:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Dim tmpSheet1 As Variant
Dim tmpSheet2 As Variant
 
'  Charger les données dans le tableau
tmpSheet1 = Sheets(1).UsedRange.value  'attention à ce que la plage ne soit pas discontinue, sinon mauvaises surprises!
tmpSheet2 = Sheets(2).UsedRange.value

Pour la seconde partie voici ce que je ferais:

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
 Dim tmpWorkbook() As Variant
 
    '[...]
 
' tmpWorkbook = Tableau (1 x nb feuilles) de tableaux.
' tmpWorkbook(i) = tableau des valeurs de la plage ligne 1 à 2064, col 9 à 11, pour la feuille n°i
    ReDim tmpWorkbook(1 To Sheets.Count)
    For s = 1 To Sheets.Count
        With Worksheets(s)
            tmpWorkbook(s) = .Range(.Cells(1, 9), .Cells(2604, 11)).Value
        End With
    Next s
 
    '[...]
 
    'Là à toi de jouer il me manque des infos
    'Sheets(s).Cells(r, c) = Sh.Cells(thisRow, c)
 
 
    '[...]
 
'    Ecriture des données dans Excel
    For s = 1 To Sheets.Count
        With Worksheets(s)
            .Range(.Cells(1, 9), .Cells(2604, 11)).Value = tmpWorkbook(s)
        End With
    Next s
 
    Erase tmpWorkbook

Bon c'est fait un peu à l'arrach aussi, mais ça te donne l'idée. A savoir ne pas parcourir les cellules pour lecture ou affectation (très lent).

Cordialement.

[x109488]

j'ai déjà été confronté à un problème de performance sous VB6. c'était pour le traitement d'un spooler d'impression avec gestion de files d'attentes.

Ma solution était de mettre de DoEvents tout juste avant et après l'appel de ta procédure.

Exemple:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Doevents
Doevents
call Workbook_SheetChange
doevents

fais le test, et tiens moi au courant

Henri

[patricktoulon]

Bonjour

En fait ton problème est très simple
Comme on te l'a dit, il faut que tu travailles sur des tableaux, voir des dictionnaires.
Maintenant quand tu dis modifier une données sur ta feuille tu voudrais que toute les lignes qui ont cette même donnée soit modifiée en même temps.
Comme tu as plusieurs colonnes quand tu fait ton tableaux il faut que leur index correspondent aux index de colonne sur ton sheet, car si tu modifies la colonne 3 par exemple, il va te falloir aller visiter toutes tes lignes en colonnes corespondantes dans ton tableau. C'est là que çà risque d'être coton.

Tu devrais regarder le lien que t'a proposé oliv

Au plaisir

[KekeStreet]

Certes, mais pas forcément besoin d'une correspondance exacte de l'adresse. Par exemple si je ne met en tableau que les colonnes qui m’intéressent, sachant que je ferais les calculs dans le tableau, il suffit que j'adapte quand je charge dans le tableau et que je fasse l'adaptation inverse en réécrivant les valeurs.

car le tableau 4*2600 sera plus rapide que le tableau 11*2600.

Pour le Doevents faudrait que j'essaie là je n'ai pas le fichier.

issoram : oui j'ai un peu baltringué là je n'ai plus pensé au .Value, c'est déjà un bon point de régler.

Par contre ce que tu me met pour la deuxième partie.. alors ça ça m’intéresse! je ne pensais pas du tout que les tableaux pouvaient fonctionner ainsi.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
    ReDim tmpWorkbook(1 To Sheets.Count)
    For s = 1 To Sheets.Count
        With Worksheets(s)
            tmpWorkbook(s) = .Range(.Cells(1, 9), .Cells(2604, 11)).Value
        End With
    Next s

Si j'ai bien compris, au ReDim, le tableau devient à 1 dimension avec autant d'élements que de feuilles.
Ensuite pour chaque feuille on remplit l'élément du tableau avec le contenu de la feuille ?

Sachant que le contenu d'une feuille est a 2 dimensions avec colonne*ligne éléments.. le code vba gère ça tout seul pas besoin de redim en 3 dimensions ? Et les éléments d'un tableau variant peuvent recevoir a leur tour des tableaux ? (en gros vba change les dimensions automatiquement ?.. j'ai des doutes car sinon je ne vois pas l'interet de la fonction ReDim).

Si ça marche en tout cas je pense que mon problème va être résolu très très trop tellement rapidement !! je vous tiens au courant


[EDIT] laissez tombé j'avais pas compris . enfait c'est juste un tableau d'autants de variants que de feuille et chacun de ces variants reçoivent chacun un tableau.. donc des tableaux de 2 dimensions dans un tableau d'1 dimension. Je cherche compliqué alors que c'est tout con
Mais ce que je ne comprend pas c'est comment accéder à un élément d'une feuille dans le tableau qui est dans le tableau.. c'est la syntaxe que je ne connais pas -> tmpWorkbook (s) (l, c) = ?

Mais si je fais encore erreur n'hésitez pas à me remettre dans le droit chemin.

[KekeStreet]

J'y suis

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
    Dim tabSheets() As Variant
 
'    Chargement des données dans le tableau
    ReDim tabSheets(1 To Sheets.Count)
    For s = 1 To Sheets.Count
        tabSheets(s) = Sheets(s).UsedRange.Value
    Next s
 
'    [...]
 
'        Calcul avec :
        tabSheets(s)(r, c) = tabSheets(Sh.Index)(thisRow, c)
 
'    [...]
 
'    Ecriture des données dans Excel
    For s = 1 To Sheets.Count
        Sheets(s).UsedRange.Value = tabSheets(s)
    Next s
    Erase tabSheets

Ce qui donne :

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
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
103
104
105
106
107
108
109
110
111
112
113
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Synchro Sh, Target
End Sub
 
Private Sub Synchro(ByVal Sh As Object, ByVal Target As Range)
'Synchronise automatiquement toutes les lignes avec le même partNumber
'(Restriction aux colonnes 9 à 11)
 
    Dim tabSheets() As Variant
    Dim tabRanges() As String
    Dim partNumber As String
    Dim firstCol As Long
    Dim firstRow As Long
    Dim lastCol As Long
    Dim lastRow As Long
    Dim memory As String
 
'    Traitement séparé pour les sélections à plages multiples
    If InStr(Target.Address, ",") <> 0 Then
        tabRanges = Split(Target.Address, ",")
        For r = 0 To UBound(tabRanges)
            Synchro Sh, Range(tabRanges(r))
        Next r
        Erase tabRanges
        Exit Sub
    End If
 
'    Optimisation performances
    Application.Cursor = xlWait
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
'    Détermination du type de plage puis délimitation du périmètre
    If InStr(Target.Address, ":") Then
        If Len(Target.Address) - Len(Replace(Target.Address, "$", "")) = 2 Then
            If IsNumeric(Mid(Target.Address, 2, 1)) Then
'                Une ou plusieurs lignes
                firstCol = 1
                lastCol = Sh.Cells(1, Columns.Count).End(xlToLeft).Column
                firstRow = Split(Replace(Target.Address, ":", ""), "$")(1)
                lastRow = Split(Replace(Target.Address, ":", ""), "$")(2)
            Else
'                Une ou plusieurs colonnes
                firstCol = Columns(Split(Replace(Target.Address, ":", ""), "$")(1)).Column
                lastCol = Columns(Split(Replace(Target.Address, ":", ""), "$")(2)).Column
                firstRow = 1
                lastRow = Sh.Cells(Rows.Count, 1).End(xlUp).Row
            End If
        Else
'            Plusieurs Cellules
            firstCol = Columns(Split(Target.Address, "$")(1)).Column
            lastCol = Columns(Split(Target.Address, "$")(3)).Column
            firstRow = val(Split(Target.Address, "$")(2))
            lastRow = val(Split(Target.Address, "$")(4))
        End If
    Else
'        Une seule cellule
        firstCol = Columns(Split(Target.Address, "$")(1)).Column
        lastCol = firstCol
        firstRow = val(Split(Target.Address, "$")(2))
        lastRow = firstRow
    End If
 
'    Restrictions à la partie synchronisée du périmètre (colonnes 9 à 11, sauf ligne 1)
    If lastCol >= 9 Then firstCol = WorksheetFunction.Max(firstCol, 9) Else Exit Sub
    If firstCol <= 11 Then lastCol = WorksheetFunction.Min(lastCol, 11) Else Exit Sub
    If lastRow >= 2 Then firstRow = WorksheetFunction.Max(firstRow, 2) Else Exit Sub
    If firstRow <= Sh.Cells(Rows.Count, 1).End(xlUp).Row Then lastRow = _
        WorksheetFunction.Min(lastRow, Sh.Cells(Rows.Count, 1).End(xlUp).Row) Else Exit Sub
 
'    Chargement des données dans le tableau
    ReDim tabSheets(1 To Sheets.Count)
    For s = 1 To Sheets.Count
        tabSheets(s) = Sheets(s).UsedRange.Value
    Next s
 
'    Balayage du périmètre ligne par ligne
    memory = ""
    For thisRow = firstRow To lastRow
        partNumber = tabSheets(Sh.Index)(thisRow, 1)
 
        If partNumber <> "" Then
            If InStr(memory, partNumber & ",") = 0 Then
                memory = memory & partNumber & ","
 
'                Recherche feuille par feuille (s) et ligne par ligne (r)
                For s = 1 To Sheets.Count
                    For r = 1 To UBound(tabSheets(s), 1)
                        If tabSheets(s)(r, 1) = partNumber Then
'                            Copie colonne par colonne (c)
                            For c = firstCol To lastCol
                                tabSheets(s)(r, c) = tabSheets(Sh.Index)(thisRow, c)
                            Next c
                        End If
                    Next r
                Next s
            End If
        End If
    Next thisRow
 
'    Ecriture des données dans Excel
    Application.EnableEvents = False
    For s = 1 To Sheets.Count
        Sheets(s).UsedRange.Value = tabSheets(s)
    Next s
    Erase tabSheets
    Application.EnableEvents = True
 
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.Cursor = xlDefault
 
End Sub

Avec les tableaux c'est très exactement 5,5x plus rapide sur mon fichier crash test (le calcul est sans doutes 20x plus rapide mais on perd un peu au chargement et à l'écriture du tableau je pense, et également avec le reste du code).

Donc là complètement satisfait, certains gros fichiers me prenaient 50s sur une colonne complète, ça ramènerait à moins de 10s, et la grande majorité des calculs, de 10s auparavant seraient maintenant réduits à 2s.

Heureux également d'avoir appris à utiliser les tableaux, même si c'est loin d'être une connaissance exhaustive du sujet.

Merci, et je met résolu mais si vous avez d'autres sujestions n'hésitez pas

[KekeStreet]

Désolé x109488 j'ai complètement oublié de te répondre : alors DoEvents ne change absolument rien du tout en fait.

Et Il reste encore un petit hic : diviser le temps de calcul par 20 c'est bien, mais lorsque je synchronise une seule cellule (donc très peu de calculs) et bien j'ai beau avoir 0,0 secondes de calculs (cool) mais la simple ligne d'écriture du tableau fini dans Excel prend 0,65s à elle seule.

Ce qui est horrible quand on sait que sans tableaux le temps total pour une seule cellule est de 0,12s

Donc je suis repartit là pour virer le "UsedRange" et découper au petit la taille de mon tableau. Si je réussi a redescendre à 0,24s soit le double, voir même 0,30 ça serait pas trop cher payé pour gagner autant de temps sur les gros calculs, mais 0,65 c'est pile poil trop long par rapport à une saisi rapide au clavier, et donc l'utilisateur qui veux aller vite en faisant cellule par cellule aura un retard sur chacunes de ses entrées.

Cette syntaxe ne marche pas.. (le "to" pose pb) quelqu'un connait-il un moyen qui marcherait ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range(Cells(2, 9), Cells(2604, 11)).Value = tabsheets(s)(2 to 2604, 9 to 13)

ps : Désolé ça fait déjà trois posts que je monologue.