Discussion :

[arnold95]

Bonjour à tous,
Comme je l'ai indiqué sur des précédents messages je suis bloqué dans une macro du fait du manque de place. Ma macro fait toutes les combinaisons possibles sauf qu'à partir d'un certain niveau d'éléments nous ne pouvons plus...par exemple si je prends 10 éléments parmi 20 excel beug. J'aurai donc souhaité ajouté une feuille à chaque fois qu'excel arrive à la dernière ligne.
Merci beaucoup de votre aide.

[jfontaine]

Si c'est indiqué dans les précédents messages, il faudrait continuer la conversation sur ces messages.

Ma macro fait toutes les combinaisons possibles

D'accord, mais quel macro??
Tu nous donnes le fichier complet dont nous ne savons pas ce qu'il doit faire.

Quand tu as besoin d'aide, soit précis et donne nous le code qui ne fonctionne pas ou qui ne fait pas ce que tu veux, en nous exmpliquant ce quil doit faire de façon que l'on comprenne.

[arnold95]

En fait j'ai envoyé l'ensemble de la procédure pour obtenir toutes les combinaisons. D'ailleurs si tu lances la macro ListPermutations, tu verras qu'elle tourne bien, maintenant, si dans la colonne tu ne mets plus lettre jusqu'à E mais jusqu'à T par exemple et que dans l'input box tu mets 11, l'ensemble des solutions ne pourrons etre affichés donc ce que je voudrais c'est que dans ce cas là par exemple les résultats soient affichés sur 3 feuilles ect... de manière à obtenir toutes les combinaisons que je souhaite et sans limites.Voila.merci

[yadla]

Bonjour arnold,

En faisant un test sur la ligne de la cellule dans laquelle tu écris... ??

Si ligne=dernière ligne -> Sheets.add

Ca marche pas ca ?

Par conte je ne vois pas trop ce tu que tu cherches à faire avec ce fichier.
Je lance macro permutation et j'ai des lettre qui se mettent dans feuille résultat. maus le plus souvent j'ai ton message d'erreur...
Je ne me suis pas penchée plus que ca sur le code

[arnold95]

Salut à tous je despère car je n'arrive pas trouver la réponse à mon problème.
En fait j'ai uen macro qui réalise des combinaisons, et donc le nombre de combinaisons augmentent rapidement avec le nombre de p élément parmi les N. Ce que je voudrais c'est qu'escel ajoute une feuille lorsqu'il n'a plus de place sur la feuille pour mettre les résultats.
Ci joint la macro et merci d'avance pour votre aide.

[ouskel'n'or]

Tu devrais continuer sur la même discussion, je ne me souviens plus ce qu'on t'avait suggéré... et qui ne fonctionne donc pas
Je pense que je t'aurais suggéré d'ajouter une page quand ton N° de ligne arrice à 65535 et de changer de feuille de calcul... ou alors de continuer sur la première colonne vide... ou alors de passer sur Access qui accepte plein de lignes...

[arnold95]

Oui voilà,c'est ce que vous m'aviez dit, le problème c'est que la macro je l'ai prise sur internet j'ai modifié 2/3 trucs pour que çà corresponde au mieux à ce que je recherchais. Et jusqu'à présent çà répondait à mes attentes. Par contre en ce qui concerne l'affichage des résultats je suis completment paumé car je suis débutant en VBA et je ne maitrise pas toutes les commandes. Je tente des boucles çà ne marche pas, j'ai essayé avec un modulo non plus et donc là je ne sais vraiment pas comment faire...Merci de ton aide.

[arnold95]

normallement le fichier doit être joint. Je vous redonne mon code si il ya un soucis.merci

'1. En A1, écrire c ou p ; (Combinaison ou Permutation)
'2. En A2, écrire la valeur de p ;(p tirés parmi N)
'3. Sous A2, écrire la liste des N éléments ;
'4. Sélectionner A1 et activer la procédure.

'Exemple:
'A1 c
'A2 3
'A3 1
'A4 2
'A5 Excel
'A6 4
'A7 *
'A8 6
'
'La procédure donne alors la liste de toutes les combinaisons
'possibles de 3 éléments choisis parmi 6.

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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
Option Explicit
 
Dim vAllItems As Variant
Dim Buffer() As String
Dim BufferPtr As Long
Dim Results As Worksheet
 
 
 
 
 
Sub ListPermutations1()
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'éléments p?", "Combinaison des élements p parmi N", 3)
  Range("A2") = message
  Const BufferSize As Long = 65535
 
  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
  If PopSize < 2 Then GoTo DataError
 
  SetSize = Rng.Cells(2).Value
  If SetSize > PopSize Then GoTo DataError
 
  Which = UCase$(Rng.Cells(1).Value)
  Select Case Which
  Case "C"
    N = Application.WorksheetFunction.Combin(PopSize, SetSize)
  Case "P"
    N = Application.WorksheetFunction.Permut(PopSize, SetSize)
  Case Else
    GoTo DataError
  End Select
  If N > Cells.Count Then GoTo DataError
 
  Application.ScreenUpdating = False
 
  nom = "résultats"
  Set Results = Worksheets.Add
  On Error Resume Next
  Application.DisplayAlerts = False
  Sheets("résultats").Delete
  Application.DisplayAlerts = True
  Results.Name = nom
 
  vAllItems = Rng.Offset(2, 0).Resize(PopSize).Value
  ReDim Buffer(1 To BufferSize) As String
  BufferPtr = 0
 
  If Which = "C" Then
    AddCombination PopSize, SetSize
  Else
    AddPermutation PopSize, SetSize
  End If
  vAllItems = 0
 
  Application.ScreenUpdating = True
  Exit Sub
 
DataError:
  If N = 0 Then
    Which = "Enter your data in a vertical range of at least 4 cells. " _
      & String$(2, 10) _
      & "Top cell must contain the letter C or P, 2nd cell is the number" _
      & "of items in a subset, the cells below are the values from which" _
      & "the subset is to be chosen."
  Else
    Which = "This requires " & Format$(N, "#,##0") & _
      " cells, more than are available on the worksheet!"
  End If
  MsgBox Which, vbOKOnly, "DATA ERROR"
  Exit Sub
End Sub
 
Private Sub AddPermutation(Optional PopSize As Integer = 0, _
  Optional SetSize As Integer = 0, _
  Optional NextMember As Integer = 0)
 
  Static iPopSize As Integer
  Static iSetSize As Integer
  Static SetMembers() As Integer
  Static Used() As Integer
  Dim i As Integer
 
  If PopSize <> 0 Then
    iPopSize = PopSize
    iSetSize = SetSize
    ReDim SetMembers(1 To iSetSize) As Integer
    ReDim Used(1 To iPopSize) As Integer
    NextMember = 1
  End If
 
  For i = 1 To iPopSize
    If Used(i) = 0 Then
      SetMembers(NextMember) = i
      If NextMember <> iSetSize Then
        Used(i) = True
        AddPermutation , , NextMember + 1
        Used(i) = False
      Else
        SavePermutation SetMembers()
      End If
    End If
  Next i
 
  If NextMember = 1 Then
    SavePermutation SetMembers(), True
    Erase SetMembers
    Erase Used
  End If
 
End Sub  'AddPermutation
 
Private 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
 
Private Sub SavePermutation(ItemsChosen() As Integer, _
  Optional FlushBuffer As Boolean = False)
 
  Dim i As Integer, sValue As String
  Dim j As Integer, w As Long, k As Long
  Dim message As Integer
  Dim ChaineASeparer
 
 
  Static RowNum As Long, ColNum As Long
 
  If RowNum = 0 Then RowNum = 1
  If ColNum = 0 Then ColNum = 1
 
  If FlushBuffer = True Or BufferPtr = UBound(Buffer()) Then
    If BufferPtr > 0 Then
      If (RowNum + BufferPtr - 1) > Rows.Count Then
        RowNum = 1
        ColNum = ColNum + 1
        If ColNum > 256 Then Exit Sub
      End If
 
 
    For k = 1 To BufferPtr
      ChaineASeparer = Split(Buffer(k), ",")
        If (RowNum + BufferPtr - 1) > Rows.Count Then
          RowNum = 1
          ColNum = Range("A1").End(xlToRight).Column + 1
        End If
 
        For w = 0 To UBound(ChaineASeparer)
            Results.Cells(RowNum + k - 1, ColNum + w).Value = ChaineASeparer(w)
        Next
    Next
      'Results.Cells(RowNum, ColNum).Resize(BufferPtr, 1).Value _
        = Application.WorksheetFunction.Transpose(Buffer())
      'RowNum = RowNum + BufferPtr
    End If
 
    BufferPtr = 0
    If FlushBuffer = True Then
      Erase Buffer
      RowNum = 0
      ColNum = 0
      Exit Sub
    Else
      ReDim Buffer(1 To UBound(Buffer))
    End If
 
  End If
  'construct the next set
  For i = 1 To UBound(ItemsChosen)
  j = 1
  sValue = sValue & ", " & vAllItems(ItemsChosen(i), 1)
  'and save it in the buffer
  Next i
  BufferPtr = BufferPtr + 1
  Buffer(BufferPtr) = Mid$(sValue, 3)
  End Sub

Merci.

[ouskel'n'or]

Sans éplucher tout le code, je testerais le N° de colonnes ici

Code :

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

1
2
3
4
5
6
7
8
9
10
11
    For k = 1 To BufferPtr
      ChaineASeparer = Split(Buffer(k), ",")
        If (RowNum + BufferPtr - 1) > Rows.Count Then
          RowNum = 1
          if Columns.count < ColNum +1 then 
                Colnum = Range("A1").End(xlToRight).Column + 1
              else
                Activeworkbook.worksheet.add
                Colnum = 1
          endif
        End If

Tu peux déjà tester ça
A+