Bonjour à tous,

J'ai ecrit du code pour rassembler dans un même tableau le croisement de plusieurs tableaux. Dans un onglet réference je stock le nom et chemins de mes differents tableaux et dans mon tableau conca, je mets en ligne 1 la colonne source et en ligne 2 le tableau source.
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
 
Private Sub GenerateVBA_Click()
debut = Now
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
ActiveSheet.DisplayPageBreaks = False
 
Set Calculateur = ThisWorkbook.ActiveSheet
 
CreaClasseurs
 
ReDim TabCalcul(Classeur(5).Feuille.Cells(1, 5).End(xlDown).Row + 2, Cells(1, 2).End(xlToRight).Column)
 
Range(Calculateur.Cells(4, 1), Calculateur.Cells(UBound(TabCalcul, 1), UBound(TabCalcul, 2))) = "" 'on nettoie la zone
 
For y = 1 To UBound(TabCalcul, 2)
    For x = 1 To 3
        TabCalcul(x, y) = Calculateur.Cells(x, y).Value
    Next
Next
 
Chargement.ProgressBarGlobal.Value = Chargement.LabelGlobal.Caption = 0 & "%"
DoEvents
 
For y = 1 To UBound(TabCalcul, 2)
 
      If TabCalcul(4, y) = "" Then
        For x = 4 To UBound(TabCalcul, 1)
            Select Case TabCalcul(2, y)
            Case Is = Classeur(1).AffNom 'Catalogue
                Recherche Classeur(1)
            Case Is = Classeur(2).AffNom 'Marche
                Recherche Classeur(2)
            Case Is = Classeur(3).AffNom 'Attendus
                Recherche Classeur(3)
            Case Is = Classeur(4).AffNom 'Livre
                Recherche Classeur(4)
            Case Is = Classeur(5).AffNom 'ME2M
                For z = y To UBound(TabCalcul, 2)
                    If TabCalcul(2, z) =Classeur(5).AffNom Then
                       TabCalcul(x, z) = Classeur(5).Feuille.Cells(x - 2, TabCalcul(1, z))
                   End If
                Next
            Case Is = Classeur(6).AffNom 'Referentiel
                'x = UBound(TabCalcul, 1)
                Recherche Classeur(6)
            Case Is = Classeur(7).AffNom 'Criticite
               Recherche Classeur(7)
            Case Else 'Calcul
                Calculateur.Cells(x, y).formulelocal = Calculateur.Cells(1, y)
            End Select
 
            Chargement.ProgressBarDetail.Value = Round(100 * (x / UBound(TabCalcul, 1)), 0)
            Chargement.LabelDetail.Caption = Chargement.ProgressBarDetail.Value & "% " & y & " - " & TabCalcul(2, y)
            DoEvents
        Next
    End If
 
    Chargement.ProgressBarGlobal.Value = Round(100 * (y / UBound(TabCalcul, 2)), 0)
   Chargement.LabelGlobal.Caption =              Chargement.ProgressBarGlobal.Value & "%"
   DoEvents
Next
 
Range(Calculateur.Cells(1, 1), Calculateur.Cells(UBound(TabCalcul, 1), UBound(TabCalcul, 2))) = TabCalcul
 
Chargement.LabelGlobal.Caption = "Terminé en " & Now - debut
 
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
 
End Sub
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
 
Private Sub Recherche(RefClasseur As CFile)
 
With RefClasseur
Set RefFound =.Feuille.Range(.Feuille.Cells(1, .RefCol),.Feuille.Cells(.DerLigne,.RefCol)).Find( _
What:=TabCalcul(x, .ColIndexCalculateur), After:=.Feuille.Cells(1,.RefCol),LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
 
    For z = y To UBound(TabCalcul, 2)
        If Not RefFound Is Nothing Then
            If TabCalcul(2, z) = RefClasseur.AffNom Then
               TabCalcul(x, z) = .Feuille.Cells(RefFound.Row, Calculateur.Cells(1, z))
            End If
        Else
            If TabCalcul(2, z) = RefClasseur.AffNom Then
                TabCalcul(x, z) = "-"
            End If
        End If
    Next
End With
 
End Sub
Ca marche bien mais... C'est très long à l'exécution. Et pour cause, chacune de mes sources contient environ 30 000 lignes.

Que ca prenne un peu de tps je veux bien l'entendre, mais c'est plus long qu'un bon gros bloc plein de recherchev.

Est ce que quelqu'un aurait une astuce pour accélérer le bousin?

Merci,
Nutch