Est'il possible d'accelerer ce code ?

Question

Bonjour

Voila ce code ci dessous permet sur excel de faire une recherche de combinaisons sur une plage de données .

1) on choisi la plage soit par exemple a1;E100
donc 100 lignes et 5 collonnes.
Chaque ligne ne comportant aucune valeur en double.

2) on chois le nombre d'elements de combinaisons.

3) on donne une cellule ou ecrire les resultats.

Ce code VBA fonctionne bien, mais serait'il possible de le rendre plus rapide ?

Merci de vos avis .

======================

Dim Prd As Integer, Niv As Integer
Dim Lg As Integer, NbCols As Integer
Dim NbLignes As Long
Dim Arr(), Cbt, MaxCbt
Dim Max As Long, NbCbt As Long

Sub Test()
  
  Dim Plage, Dest, P As Range
  Dim Prof, Combins, I As Long
  
  With Application
    Set Plage = .InputBox("Plage de recherche", Type:=8)
    If VarType(Plage) = vbBoolean Then Exit Sub
    Prof = .InputBox("Nombre d'éléments", Type:=1)
    If VarType(Prof) = vbBoolean Then Exit Sub
    Set Dest = .InputBox("Destination", Type:=8)
    If VarType(Dest) = vbBoolean Then Exit Sub
    Combins = CBS(Range(Plage.Address(External:=True)), CInt(Prof))
    .ScreenUpdating = False
  End With
  
  Dest.CurrentRegion.ClearContents
  For Each P In Dest.Resize(UBound(Combins), Prof).Rows
    I = I + 1
    P = Combins(I)
  Next P

End Sub

Function CBS(Plage As Range, Nombre As Integer)

  Dim I As Long
  
  NbLignes = Plage.Rows.Count
  ReDim Arr(1 To NbLignes)
  For I = 1 To NbLignes
    Arr(I) = Plage.Rows(I)
  Next I
  Prd = Nombre
  Lg = Plage.Columns.Count  Niv 0: Max 0: NbCbt = 0
  ReDim Cbt(1 To Prd)
  ReDim MaxCbt(1 To 1)
  For I = 1 To UBound(Arr)
    Recurse I, 1
  Next I
  Application.StatusBar = False
  CBS = MaxCbt

End Function

Private Sub Recurse(L As Long, ByVal Cpt As Integer)
  
  Dim I As Integer
  Static Ligne As Long, C As Integer
  Static Nb As Long, T As Long
  
  On Error Resume Next
  Niv = Niv + 1
  For I = Cpt To Lg
    Cbt(Niv) = Arr(L)(1, I)
    If Niv = Prd Then
      Nb = 1
      For Ligne = L + 1 To NbLignes
        For C = 1 To Prd
          T = Application.Match(Cbt(C), Arr(Ligne), 0)
          If Err Then Err.Clear: Exit For
        Next C
        If C > Prd Then Nb = Nb + 1
      Next Ligne
      If Nb >= Max Then
        If Nb = Max Then
          NbCbt = NbCbt + 1
          ReDim Preserve MaxCbt(1 To NbCbt)
        Else
          NbCbt = 1
          ReDim MaxCbt(1 To 1)
        End If
        MaxCbt(NbCbt) = Cbt
        Application.StatusBar = NbCbt & " combinaison(s) à " _
          & Max & " occurences (" & Format$(L / NbLignes, "0.0%") & ")"
        Max = Nb
      End If
    Else: Recurse L, I + 1
    End If
  Next I
  Niv = Niv - 1

End Sub

cs_PhilippeE · Answer

Je ne peux te conseiller qu'une chose, limiter les mises à jours visibles par l'utilisateur pendant le traitement, ça prend du temps CPU pour pas grand chose (par exemple pour la progression dans ta StatusBar, tu devrais la mettre à jour que par pallier de 5% par exemple)

Sinon à part supprimer la récursivité ou travailler en Excel invisible je ne vois pas grand chose.

bouv · Answer

Petite astuce, vraiment pas grand chose mais cela peut optimiser le code sur de grande boucle ou des PC tres lents.

Dim Arr(), Cbt, MaxCbt
Rajoute "As String" sinon ils sont de type Variant un peu plus lent.

Tu met quelques variables en Integer. Peux-tu les mettre en Long (plus rapide).
A Noter : 
Long                    (La plus rapide) 
Integer  
Byte  
Single  
Double  
Currency               (La plus lente)

Enfin, extrait de la MSDN

Mettez en mémoire cache les propriétés souvent utilisées dans des variables :
Vous pouvez accéder à la valeur d'une variable et la définir plus rapidement que celle d'une propriété. Si vous devez souvent accéder à la valeur d'une propriété (par exemple, dans une boucle), votre code s'exécutera plus rapidement si vous affectez la propriété à une variable extérieure à la boucle et utilisez cette variable à la place de la propriété. Les variables sont généralement 10 à 20 fois plus rapides que les propriétés du même type.

N'accédez jamais plus d'une fois à la valeur d'une propriété donnée dans une procédure, sauf si vous savez que la valeur a été modifiée. Affectez plutôt la valeur de la propriété à une variable et utilisez celle-ci dans la suite du code. Par exemple, le code suivant s'exécute très lentement :

For i = 0 To 10
   picIcon(i).Left = picPallete.Left
Next I

Pour le rendre plus rapide, réécrivez-le comme suit :

picLeft = picPallete.Left
For i = 0 To 10
      picIcon(i).Left = picLeft
Next I

++

Est'il possible d'accelerer ce code ?

2 réponses

Discussions similaires