Discussion :

[jad73]

bonjour le forum
j'ai un programme en vba,si je l'exécute mon ordinateur doit tourner pendant 8 heures,c'est un peu long. On me dit "change d'algorithme" mais pas lequel ou "ecrit le dans un autre langage" mais toujours pas lequel.
pour l'algorithme ça je ne saurais pas y faire, pour le langage il faudrait qu'il soit assez facile à apprendre.
Si quelqu'un a une idée merci de son conseil.
merci
a+

[Oliv-]

Salut,
8 h c'est effectivement bien long.
Il faudrait que tu publis ton code et que tu expliques ce que tu dois faire.

[Philippe Tulliez]

Bonjour,
Il y a un tas de technique pour accélérer son code VBA.
La règle n° 1 est la déclaration obligatoire des variables.
Utiliser des variables objets pour les classeurs, feuilles, cellules etc...
Ensuite dans certain cas bloquer l'affichage écran et le calcul automatique

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
With Application
.ScreenUpdating = False
CalcSatus = .Calculation  ' Mémoriser la propriété Calculation
.Calculation = xlCalculationManual
End With

Sans oublier à la fin de procédure

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
With Application
.ScreenUpdating = True
.Calculation = CalcSatus
End With

En ayant déclarer la variable CalcSatus comme Integer en tête de module.
Dans certain encore travailler avec des variables tableaux
A lire Comment améliorer les performances (augmenter la vitesse) de mon application ? (C'est pour le VB mais beaucoup de ces recommandations sont valables pour VBA.
A lire également OPTIMISATION EN VISUAL BASIC APPLICATION

[jad73]

bonjour Oliv_,Philippe Tulliez,le forum
voici le code,c'est surtout la partie 'combinaison qui est longue.
il recherche dans la plage "Ktir" les 4 numéros qui sortent le plus souvent ensemble et les inscrit dans le tableau AW2:BA.
pour Philippe Tulliez,je les inscrirais ou dans le code les données que vous indiquer.
Les lignes 8 et 12 ont été déactivé car trop long comme calcul. Elles devaient analyser 190 couplés
merci

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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
Option Explicit
Option Base 1
 
Sub Macro_Atester()
Dim Ligne As Long, Indice As Long
'efface la BdD Y:AR
  Worksheets("Feuil1").Select
  'For Ligne = 2 To Range("BN" & Rows.Count).End(xlUp).Row
    Range("Y2:AR3012").ClearContents
 
'ajoute 2eme couplé col BN:BO a U1:V1
   ' Range("U1:V1").Value = Range("BN" & Ligne & ":BO" & Ligne).Value
    Calculate
'extraire les lignes de A:T a Y2
    Dim I&, fin&, aa, bb, y&, a&
    With Feuil1
      fin = .Range("A" & Rows.Count).End(xlUp).Row
      aa = .Range("A2:W" & fin)
    End With
    y = 1
    ReDim bb(UBound(aa, 2), y)
    For I = 1 To UBound(aa) - 1
      If aa(I + 1, 22) = 1 Then
        ReDim Preserve bb(UBound(aa, 2), y)
        For a = 1 To UBound(aa, 2) - 3
          bb(a, y) = aa(I, a)
        Next a
        y = y + 1
      End If
    Next I
 
    Range("Y2").Resize(UBound(bb, 2), UBound(bb)) = Application.Transpose(bb)
 
 'Combinaison
  Dim D As Integer, K As Integer, L As Integer, M As Integer
  Dim NbMax As Integer
  Dim Tablo(1 To 70, 1 To 70, 1 To 70, 1 To 70) As Integer
  Dim J As Long
  Dim Resultat(1 To 1, 1 To 5)
  Dim Tbl1
  Dim Nombre As Integer
 
    Application.ScreenUpdating = False
    Tbl1 = Range("Feuil1!Ktir")
    NbMax = UBound(Tbl1, 2)
 
    For J = 1 To UBound(Tbl1)
      For D = 1 To NbMax - 3
        For K = D + 1 To NbMax - 2
          For L = K + 1 To NbMax - 1
            For M = L + 1 To NbMax
            Tablo(Tbl1(J, D), Tbl1(J, K), Tbl1(J, L), Tbl1(J, M)) = Tablo(Tbl1(J, D), Tbl1(J, K), Tbl1(J, L), Tbl1(J, M)) + 1
            Next M
          Next L
        Next K
      Next D
    Next J
 
    Range("AW2:BG" & Rows.Count).ClearContents
 
    Indice = 0
      For D = 1 To 70
        For K = 1 To 70
          For L = 1 To 70
            For M = 1 To 70
              If Tablo(D, K, L, M) > 0 Then
                Indice = Indice + 1
                Resultat(1, 1) = D
                Resultat(1, 2) = K
                Resultat(1, 3) = L
                Resultat(1, 4) = M
                Resultat(1, 5) = Tablo(D, K, L, M)
                Cells(1 + Indice, "AW").Resize(1, 5) = Resultat
 
              End If
            'End If
            Next M
          Next L
        Next K
      Next D
 
    Range("AW2:BA" & Indice + 1).Copy
    Range("BC2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                              SkipBlanks:=False, Transpose:=False
 
    With ActiveSheet.Sort
      .SortFields.Clear
      .SortFields.Add Key:=Range("BG2:BG" & Indice + 1), SortOn:=xlSortOnValues, _
                      Order:=xlDescending, DataOption:=xlSortNormal
      .SetRange Range("BC2:BG" & Indice + 1)
      .Header = xlGuess
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
    End With
 
'tri BC:BF
    For J = 2 To 23
      Range("BC" & J).Resize(1, 4).Copy
      Cells(2 + ((J - 2) * 4), "BJ").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Next J
 
'fin tri BC:BF
      Range("$BJ$2:$BJ$89").RemoveDuplicates Columns:=1, Header:=xlNo
'colonne BJ rangée en BP
    Dim vLigne As Long
    vLigne = Range("BP65536").End(xlUp).Row + 1
    If vLigne < 2 Then vLigne = 2
    Range("BJ2:BJ26").Copy
    Range("BP" & vLigne).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=True
 
    Range("AT1").Select
  'Next Ligne
  Range("Y2:AR3012").ClearContents
  Range("AW2:BG" & Rows.Count).ClearContents
 
  Application.CutCopyMode = False
End Sub

[issoram]

Bonjour,

Dans la partie "combinaison", as-u as une idée du temps mis par chacune des boucles? Tu peux utiliser Timer() pour chiffrer ça. Mais bon un traitement de 8h c'est un peu fastidieux à lancer.

Niveau optim sur le code en lui même, à mon avis il n'y a pas grand chose à faire. Donc effectivement c'est peut être au niveau de l'algo qu'il faut regarder.
De ce côté là, il faudrait que tu nous fournisses plus d'explications sur ce qu' est censé faire le code (avec un classeur de données par exemple). Perso, avec uniquement le code brut, j'ai un peu de mal à t'aider.

Bon courage.

[jad73]

bonjour issoram
je joint le fichier
la colonne V sert afficher des 1 par rapport au donnée U1:V1. C'est pour indiquer la ligne ou se trouve le couplé.
le code 'extraire les lignes..', extrait la ligne avant celle du 1,ex: si le 1 se trouve en ligne 5, c'est la ligne 4 qui sera extraite.Elle seront inscrites dans la plage Y2:AR...
jusque la c'est assez rapide.
Le code 'combinaison' lui, recherche dans la plage Y2:AR... les 4 numéros qui sortent le plus souvent ensemble, la c'est long.
Après le reste du code ce sont des tris, elimination de doublons et inscription des données en col BP avec vligne.
sur le fichier joint la base est raccourci pour qu'il puisse passer.
une erreur doit se produire aussi car quand je teste les couplés un par un les résultats ne sont pas les meme que si je teste les 5 couplés a la suite.
Ligne en CS:DS sont les 5 couplés testé a la suite.
Le test d'un couplé est rapide.
merci

[Oliv-]

Salut,
A quoi cela sert il au final ?

Attention nb.si() est assez gourmant en ressource il faut veiller à utiliser
Application.Calculation = xlCalculationManual comme indiqué par Philippe.

J'ai lancé ta macro et cela ne prend que quelques minutes chez moi ?