Bonjour à tous,

Je reviens encore vers vous pour essayer de Passer mon code en tableau.
J’ai construis (avec l’aide de tout le monde, mon niveau en VBA est faible) un programme qui fonctionne. Car contre il a l’inconvénient d’avoir un temps de traitement voisin de 7h, Certes la travail se fait de nuit mais c’est quand même trop long. J’ai commencé par lire les tutos à disposition traitant des tableaux et des variables tableaux mais j’avoue avoir du mal à comprendre. Apres une multitude d’essais, j’arrive juste a lancer une formule et réaliser quelques boucles simples, par contre je ne sais pas s’il est possible de réaliser les fonctions dont j’ai besoin pour mon programme (recherche du max et le nombre qui a donné ce max).
Le plus gros consommateur de temps (je pense) est le test de la boucle de 1000 valeurs par colonne (For "a" ligne 40), je balaye la même formule de 0 à 1 avec un pas de 0.001 pour en déterminer le résultat maxi d’un test.

Un grand merci par avance
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
Sub TestC1()
 
Deb = Timer
 
   Application.ScreenUpdating = False
 
   Dim shtFrom As Worksheet, shtTo As Worksheet
   Dim a As Long, Str_Val_1 As String, Cel As Range
   Dim Moyx As Single
   Dim Moyy As Single
   Dim Moyz As Single
   Dim DSx As Single
   Dim DSy As Single
 
Sheets("C").Range("A20:F3379").ClearContents
 
        For decal = 1 To 690
 
 
        Set shtTo = Worksheets("C")
        Set shtFrom = Worksheets("C")
 
'La formule de la colonne a tester est glissée en derniere ligne
 
        Range("AX20").Offset(0, decal).Select
        Selection.AutoFill Destination:=Range("AX20:AX3379").Offset(0, decal), Type:=xlFillDefault
 
'Copie successive des colonnes du tableau vers la colonne A20
 
        shtTo.Range("A20:A3379").Value = shtFrom.Range("AX20:AX3379").Offset(0, decal).Value
        Str_Val_1 = "=RC[-1]+sin(RC[-2]/R"
        Set Cel = Range("F1")
 
'Pour gagner en mémoire, on efface la formule de la colonne a tester
 
        Range("AX21:AX3379").Offset(0, decal).ClearContents
 
'La formule en A20 est testée de 0 à 1 avec un pas de 0.001 pour determiner le résultat max du test
 
             For a = 20 To 1019
 
             Range("C20").FormulaR1C1 = Str_Val_1 & a & "C7)"
             Range("C20").AutoFill Destination:=Range("C20:C3379"), Type:=xlFillDefault
 
'Test, évite de passer par Formule sur feuille Excel
 
             Moyx = WorksheetFunction.Average(Range("C20:C2369"))
             Moyy = WorksheetFunction.Average(Range("C2370:C3309"))
             Moyz = WorksheetFunction.Average(Range("C20:C3309"))
             DSx = WorksheetFunction.DevSq(Range("C20:C2369"))
             DSy = WorksheetFunction.DevSq(Range("C2370:C3309"))
 
             'Le résultat du test est copié dans la cellule en face de la valeur A
 
             Range("E1") = 3288 * ((2350 * (Moyx - Moyz) ^ 2) + (940 * (Moyy - Moyz) ^ 2)) / (DSx + DSy)
             Range("E1").Copy
             Cel.Offset(a - 1, 0).PasteSpecial Paste:=xlPasteValues
 
            'Recalcul des données en fonction de la valeur max du test
 
             Range("C20").FormulaR1C1 = Str_Val_1 & "1C7)"
             Range("C20").AutoFill Destination:=Range("C20:C3379"), Type:=xlFillDefault
 
             Next a
 
             'Copie pour controler l'augmentation des resultats et incrémenter le test
 
             'Evite de passer par Formule sur feuille Excel
 
        Range("G1").FormulaLocal = "=DECALER(F19;EQUIV(MAX(F20:F1019);F20:F1019;0);1)"
        Range("G1").Value = Range("G1").Value
 
        shtTo.Range("I1").Offset(decal - 1, 0).Value = shtFrom.Range("G1").Value
        shtTo.Range("B20:B3379").Value = shtFrom.Range("C20:C3379").Value
        shtTo.Range("T20:T3379").Value = shtFrom.Range("C20:C3379").Value
 
        Next decal
 
     ActiveWorkbook.Save
             Application.ScreenUpdating = True
                  MsgBox "J'ai bossé " & Timer - Deb & " seconde"
End Sub