condition VBA

[vincent noah]

Bonjour à tous , heureux de vous retrouver !!

voici un extrait de mon code:

Sub combinaisons()
Dim lin&, col&, rc&, m%, n%, o%, p%, q%, tir$()
lin = 1
col = 0
rc = Rows.Count
ReDim tir(1 To rc, 0)
    For m = 1 To 20
        For n = m + 1 To 20
            For o = n + 1 To 20
                For p = o + 1 To 20
                    For q = p + 1 To 20

voila j'ai une petite difficulté à trouver l'expression exacte VBA pour ne pas faire apparaître la combinaison qui contient par exemple le n° 1 et ( 7,6,9,10) . etc .
j'ai bien compris qu'il faut que je combine toutes les possibilités parmi m ,n ,o, p, q (2 parmi 10
) donc trop long .
ne pourrez t'on pas faire plus court du genre : if not armi (m , n, o, p, q ) il y'a (1 et 7 )ou (1 et 6) ou (1et9) ou (1et 10) then
?
voila je bloque là dessus pourtant cela me semble simple

j'espère était clair. merci de votre aide

bonne soirée.

 

[job75]

Bonjour vincent noah, le forum,

Il vaut sans doute mieux utiliser le tableau tablo avec une seule colonne.

Il est déchargé dans la feuille quand il est plein :

Sub Combinaisons()
Dim t#, nmax%, exclu1, exclu2, rc&, tablo$(), m%, n%, o%, p%, q%, lig&, col%
t = [NOW()]
nmax = 82 'modifiable
exclu1 = [D1].CurrentRegion.Resize(, 2) 'couples
exclu2 = [L1].CurrentRegion.Resize(, 3) 'triples
rc = Rows.Count
ReDim tablo(1 To rc, 0 To 0)
Set dicoexclu1 = CreateObject("Scripting.Dictionary")
Set dicoexclu2 = CreateObject("Scripting.Dictionary")
For m = 1 To UBound(exclu1): dicoexclu1(exclu1(m, 1) & " " & exclu1(m, 2)) = "": Next
For m = 1 To UBound(exclu2): dicoexclu2(exclu2(m, 1) & " " & exclu2(m, 2) & " " & exclu2(m, 3)) = "": Next
[P1].CurrentRegion.ClearContents 'RAZ
For m = 1 To nmax - 4
  For n = m + 1 To nmax - 3
    If CoupleExclu(n, m) Then GoTo 1
    For o = n + 1 To nmax - 2
      If CoupleExclu(o, m, n) Or TripleExclu(o, m, n) Then GoTo 2
      For p = o + 1 To nmax - 1
        If CoupleExclu(p, m, n, o) Or TripleExclu(p, m, n, o) Then GoTo 3
        For q = p + 1 To nmax
          If CoupleExclu(q, m, n, o, p) Or TripleExclu(q, m, n, o, p) Then GoTo 4
          lig = lig + 1
          tablo(lig, 0) = m & " " & n & " " & o & " " & p & " " & q
          If lig = rc Then [P1].Offset(, col).Resize(lig) = tablo: Application.ScreenUpdating = True: DoEvents: _
            ReDim tablo(1 To rc, 0 To 0): [P1].Offset(, col).Select: Columns("P").Offset(, col).AutoFit: _
              lig = 0: col = col + 1: Application.StatusBar = "Colonne " & col & Format([NOW()] - t, " - hh:mm:ss")
4       Next q
3     Next p
2   Next o
1 Next n
Next m
If lig Then [P1].Offset(, col).Resize(lig) = tablo
Columns("P").Offset(, col).AutoFit
MsgBox col + 1 & " colonne(s) - " & Format(86400 * ([NOW()] - t), "0.00 \s")
End Sub

Cela allège la mémoire et permet de suivre ce qui se passe.

Fichier (2), avec nmax = 82 la macro s'exécute chez moi en 17 minutes.

Edit : le fichier obtenu contient 26 347 449 combinaisons et pèse 242 (254) Mo...

Bonne journée.