Optimisation du code / Combinaison sans repétitions

Bonjour ,

Je possede une macro qui crée toutes les combinaisons possibles sans répétitions (pris sur internet). Tout fonctionne parfaitement bien , mais seulement je souhaite tester toute les combinaisons de 9 parmi 33 => 38 millions de combinaisons ... du coup le processus est interminable : voici le code : à part le Application.ScreenUpdating = False/True je n'ai pas trouvé d'autre solution pour accelerer le process donc si qqn voix qqc je prend

Voici mon code :

Option Explicit

Dim Save As Double
Dim vAllItems As Variant
Dim Buffer() As String
Dim BufferPtr As Long
Dim Results As Worksheet

Sub ListPermutations()
Application.ScreenUpdating = False
Worksheets("combinaisons").Select

Sheets("Choix").Select
Save = Cells(7, 10).Value
Worksheets("combinaisons").Select

Range("A1").Select
  Dim Rng As Range
  Dim PopSize As Integer
  Dim SetSize As Integer
  Dim Which As String
  Dim N As Double
  Dim message As Integer
  Dim nom As String
  Dim sh As Worksheet, trouvé As Boolean
  trouvé = False

  message = InputBox("nombre d'actifs?", "Combinaison des actifs", 3)
  Range("A2") = message

  Set Rng = Selection.Columns(1).Cells
  If Rng.Cells.Count = 1 Then
    Set Rng = Range(Rng, Rng.End(xlDown))
  End If

  PopSize = Rng.Cells.Count - 2

  SetSize = Rng.Cells(2).Value

  Which = UCase$(Rng.Cells(1).Value)
  Select Case Which
  Case "C"
    N = Application.WorksheetFunction.Combin(PopSize, SetSize)
  End Select

Sheets("Choix").Select
  vAllItems = Rng.Offset(2, 0).Resize(PopSize).Value

  BufferPtr = 0

  If Which = "C" Then
    AddCombination PopSize, SetSize

  End If
  vAllItems = 0

  Exit Sub
Application.ScreenUpdating = True
End Sub

Sub AddCombination(Optional PopSize As Integer = 0, _
  Optional SetSize As Integer = 0, _
  Optional NextMember As Integer = 0, _
  Optional NextItem As Integer = 0)

  Static iPopSize As Integer
  Static iSetSize As Integer
  Static SetMembers() As Integer
  Dim i As Integer

  If PopSize <> 0 Then
    iPopSize = PopSize
    iSetSize = SetSize
    ReDim SetMembers(1 To iSetSize) As Integer
    NextMember = 1
    NextItem = 1
  End If

  For i = NextItem To iPopSize
    SetMembers(NextMember) = i
    If NextMember <> iSetSize Then
      AddCombination , , NextMember + 1, i + 1
    Else
      SavePermutation SetMembers()
    End If
  Next i

  If NextMember = 1 Then
    SavePermutation SetMembers(), True
    Erase SetMembers
  End If

End Sub  'AddCombination

Sub SavePermutation(ItemsChosen() As Integer, _
  Optional FlushBuffer As Boolean = False)

  Dim i As Integer, sValue As String
  Dim j As Integer
  Dim message As Integer

  Static RowNum As Long, ColNum As Long

For i = 1 To UBound(ItemsChosen)

  If Cells(7, 10).Value < Save Then

  Save = Cells(7, 10).Value
  Range("D1:L1").Copy
  Sheets("Combinaisons").Select
  Cells(1, 2).Select
  ActiveSheet.Paste

  Sheets("Choix").Select

  End If

  j = 1

  Cells(1, i + 3).Value = vAllItems(ItemsChosen(i), 1)

  Next i

  End Sub

Merci

Bonjour,

Et tu veux en faire quoi de tes 38 millions de combinaisons ?

Quel est l'intérêt d'avoir 342 (9x38) colonnes d'un million de lignes ? Tu n'auras pas assez de ta vie pour les lire...

eric

Bonsoir

Je te posterai une macro itérative rapide demain

A+

eriiic a écrit :

Bonjour,

Et tu veux en faire quoi de tes 38 millions de combinaisons ?

Quel est l'intérêt d'avoir 342 (9x38) colonnes d'un million de lignes ? Tu n'auras pas assez de ta vie pour les lire...

eric

Je colle les différentes combinaisons dans des cellules qui sont directement relié à d'autres formule mais ce n'est pas ce que je veux en faire le probleme .

JJ1 a écrit :

Bonsoir

Je te posterai une macro itérative rapide demain

A+

Ok merci beaucoup JJ1

mais ce n'est pas ce que je veux en faire le probleme

Si, justement. Peut-être es-tu sur une mauvaise piste de résolution.

A générer ça prend un peu de temps. Mais ensuite il faudra bien les traiter (sinon pas d'intérêt à les générer), 38 millions c'est énorme mais bon.

eric

J'avais déjà eu un problème au niveau de la lenteur du traitement des combinaisons. Je suis passé d'a peu près 2-3 combinaisons traitées/minute à un traitement presque instantanée au moment ou elles sont disponibles. et je pense que la rapidité du processus ne peut que passer par une augmentation de la vitesse de génération de combinaisons.

Peut etre au niveau du copié-collé ou du changement de feuillet je ne sais pas ... Si je pouvais gratter 0,01 secondes pour chaque creation de combinaisons. (38 M * 0,01 seconde = 4,3 jours de traitement economisés lol

JJ1 t'as dit qu'il s'en occuperait, mais tu n'as même pas dit sous quelle forme tu voulais le résultat...

eric

Oui c'est vrai ,

par exemple : j'ai des nombres de 18 à 50 et je voudrais que toutes les combinaisons de 9 parmi 33 soient appliquées sur une plage de cellule . Dans le code :

Cells(1, i + 3).Value = vAllItems(ItemsChosen(i), 1)

chaque cellule va prendre une valeur de la combinaison.

C'est sous cette forme que je souhaite avoir les résultats mais je pense que JJ1 va avant tout proposer une methode qui permettra de generer des combinaisons plus vite, d'ou un enchaînement plus rapide sur la plage de cellule souhaité.

NB : Je préfere re-preciser qu'une combinaison "18 19 20 21 22 23 24 25 26" est pareil que "19 18 20 21 22 23 24 25 26" .

Bonjour,

La combinaison itérative commence à 1 et ne convient pas à ton cas.

Regarde si ce code est plus rapide/

(j'ai testé avec 15 nombres en combinaisons de 9)

a+

OK merci . Je vais adapter la macro pour mon cas

Mais à premiere vu avec du 9 parmi 15 :

ma macro => creation de combinaison + traitement de donnée : 8 minutes

la tienne => juste avec la creation de combinaison : 7 secondes .

Il n'y a pas photo je vais adapter la macro.

Merci beaucoup

EDIT : ta macro avec les traitement met 5 minutes pour du 9 parmi 15. Donc toujours plus rapide .

Eric avait raison je vais optimiser le traitement de donnée maintenant merci