Optimisation d'un code VBA (remplissage tableau)
Bonjour tout le monde :)
Je développe une petite macro et je suis confronté à un gros problème. Le temps de traitement de ma macro est assez long, plusieurs dizaine de minutes... J'essaye donc d'optimiser mon code et mes fonctions pour gagner du temps. Or je bloque à un endroit, pas moyen de trouver une méthode plus rapide.
Concrètement, j'ai besoin de remplir un tableau avec 220 lignes et 4 colonnes.
De la ligne 1 à 110 :
Colonne 1 : les 10 premiers chiffres (1,2,3,4,5,6,7,8,9,10)
Colonne 2 : 10 fois 0, dix fois le 1, dix fois le 2, dix fois le 3, .... jusqu'à 10 fois le 10
Colonne 3 : colonne 1
Colonne 4 : colonne 2
De la ligne 111 à 220 :
Colonne 1 : 10 fois 0, dix fois le 1, dix fois le 2, dix fois le 3, .... jusqu'à 10 fois le 10
Colonne 2 : les 10 premiers chiffres (1,2,3,4,5,6,7,8,9,10)
Colonne 3 : colonne 1
Colonne 4 : colonne 2
Je pense que la structure de mon code pourrait être optimisé mais même en me creusant les méninges, pas moyen de trouver une solution plus efficace..
Si quelqu'un a du temps à revendre je veux bien un petit peu d'aide svp :D
Merci !
PS : je vous mets le fichier en pj
Salut DubCork,
Sub Bouton1_Cliquer()
'
Application.ScreenUpdating = False
'
For x = 0 To 10
For y = 1 To 10
Union(Cells((x * 10) + y, 1), Cells((x * 10) + y, 3)) = y
Union(Cells(110 + (x * 10) + y, 2), Cells(110 + (x * 10) + y, 4)) = y
Union(Cells((x * 10) + y, 2), Cells((x * 10) + y, 4)) = x
Union(Cells(110 + (x * 10) + y, 1), Cells(110 + (x * 10) + y, 3)) = x
Next
Next
'
Application.ScreenUpdating = True
'
End Sub
A+
une autre possibilité :
Sub Bouton1_Cliquer()
Dim T(1 To 220, 1 To 4) As Double, i As Long, x As Long, y As Long
deb = Timer
For i = 1 To 110
x = x + 1
If x > 10 Then
x = 1
y = y + 1
End If
T(i, 1) = x
T(i + 110, 1) = y
T(i, 2) = y
T(i + 110, 2) = x
T(i, 3) = x
T(i + 110, 3) = y
T(i, 4) = y
T(i + 110, 4) = x
Next
With Worksheets("Feuil1") 'adapter le nom de la feuille
.Range("F1").Resize(220, 4) = T ' adapter la cellule de copie du tableau
.Range("J1") = Timer - deb
End With
End SubPas compris Le temps de traitement de plusieurs dizaine de minutes...
Avec ce code , traitement en +/- 0,03 seconde; avec celui du classeur : +/-0,3 seconde. On est loin des 10mn....
A+
Bien vu, le tableau, AlgoPlus !
M'en vais adapter mon code à ton idée, tiens !
A+
Merci beaucoup pour vos retours ! :)
Je vais voir laquelle utiliser ahaha
J'ai plusieurs dizaines de minutes parce que mon programme est beaucoup plus long. Je ne vous ai envoyé qu'un petit fragment.
bonne journée
Oui c'est sur, mais économiser qqes secondes sur une opération se sera un nombre de fois exponentiel, ça reste intéressant ! ;)
Ah, ben, je m'étais bien planté, AlgoPlus...
Focalisé sur le temps annoncé de dizaines de minutes et la construction de la boucle, je n'avais pas prêté attention plus que ça au code de Dubcork qui utilise effectivement un tableau. J'ai péché par précipitation.
Dim tTab(1 To 220, 1 To 4) As Integer
'
Cancel = True
Application.ScreenUpdating = False
'
T = Timer
For x = 0 To 10
For y = 1 To 10
tTab((x * 10) + y, 1) = y
tTab((x * 10) + y, 3) = y
tTab(110 + (x * 10) + y, 2) = y
tTab(110 + (x * 10) + y, 4) = y
tTab((x * 10) + y, 2) = x
tTab((x * 10) + y, 4) = x
tTab(110 + (x * 10) + y, 1) = x
tTab(110 + (x * 10) + y, 3) = x
Next
Next
[A1].Resize(220, 4).Value = tTab
'
Application.ScreenUpdating = True
MsgBox T & " " & Timer & " " & Format(Timer - T, "0.0000")Je serais quand même curieux de connaître le fin du fin de cette fameuse boucle!
A+