Discussion :

[T0n10]

Bonjour à tous,

J'ai un souci peu banal ... et je n’avoue ne pas savoir comment le résoudre. En fait, j'ai un tableau à de 600 lignes environ. Ce tableau est issu d’une extraction de base de données et se compose en deux parties : Colle A à D et Colonne E à H (donc 2 fois quatre colonnes).

- Ces deux colonnes traitent des mêmes objets (mêmes infos et tout à part la référence de l’objet). Pour info, la présentation est ainsi car il existe un lien de filiation entre les deux objets de chaque ligne.
- L’algorithme a pour objectif de remettre de l’ordre en insérant/déplaçant sous « A1 : D1 » les cellules « E1 :H1 », sous « A2 : D2 » les cellules « E2 :H2 » etc
- Donc à la fin de l’exécution le tableau a doublé sa taille (le range a une taille variable donc)

J’espère être clair sur la contextualisation

Mon code est le suivant et il fonctionne.

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
Sub test_mere_fille()
 
Application.ScreenUpdating = False
 
[…]
 
i = 3
 
doublon = False
 
Do While Worksheets("BBC").Cells(i, 1).Value <> "" ‘parcourt le tableau tant qu’il y a des cellules non vide en colonnes A
 
    suiv = i + 1
 
    'existe-t-il une fille (au moins une)
    If Cells(i, 9).Value <> "" Then
       fille_trouvee = True
       nb_insert = 1 ‘prevision d’inserer au moins une ligne
 
        'tant que le contenu de la cellule est le même que celui de la cellule suivante (cas ou un objet mère a plusieurs objets filles)
        While Cells(suiv, 1).Value = Cells(i, 1)
            doublon = True 'flag qui dit que des doublons sont trouvés
            nb_insert = nb_insert + 1 'calcule le nombre de doublons et déduit le nombre de ligne à insérer (incrémente à chaque itération)
            suiv = suiv + 1
        Wend
 
    'si une fille ou des doublons ou plus sont trouvés
        If fille_trouvee = True Or doublon = True Then
            doublon = False 'reinitialise la valeur
            fille_trouvee = False ''reinitialise la valeur
            With Worksheets("BBC")
                .Rows(i + nb_insert).Resize(nb_insert).Insert 'insere le bon nombre de ligne
                .Range("I" & i & ":P" & i + nb_insert - 1).Cut .Range("A" & i + nb_insert) 'déplace les cellules concernées
 
                If nb_insert <> 1 Then 'supprime les mère doublons
                    Worksheets("BBC").Rows(i & ":" & i + nb_insert - 2).Delete
                End If
 
            .Rows(i + 1 & ":" & i + nb_insert).Group ‘groupe les lignes histoire de garder la trace de la structure initiale
            End With
 
           End If
 
    End If
 
    i = i + nb_insert + 1 'reajuste la valeur de i après insert
 
Loop
 
Application.ScreenUpdating = True
 
'ActiveSheet.Outline.SummaryRow = 0 'mets le '+' en haut
 
End Sub

Mon problème c'est que l’exécution va arriver à la 200/300 lignes en 2 secondes puis le code va se mettre tout d'un coup à ramer, et ce ralentissement ne va faire que s'accroitre a chaque itération. L’exécution va s'achever après une bonne vingtaine de minutes, ce qui n'est pas acceptable.

Petite animation qui présente le problème :



Application.ScreeUpdating est bien sur False.

On voit bien que ce sont les instructions du groupes With qui rament
Quelqu'un aurait un avis sur la question ?

Merci d'avance.

Tonio