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