Tableaux et Variables tableaux
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:
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 |
