Multiples combinaisons 3 colonnes

[alan]

Bonjour,

J'ai 3 colonnes des donnees et j'aimerai effectuer, grace a un code, toutes les combinaisons que peuvent me fournir ses donnees.
Sur mon example, le code me reecrirai clairement toutes les possibilites et comme il y en a beaucoup, comment pourrai je rendre plus attractif la lecture de celles ci? Un tableau 3D me semblait ideal mais sur Excel, je pense qu'il est difficile de le faire.
Merci d'avance

 

[PMO2]

Re : Multiples combinaisons 3 colonnes

Bonjour,

Une piste, avec le code suivant, pour calculer toutes les combinaisons.
Le résultat s'inscrit dans une nouvelle feuille.
Quant à l'attractivité que vous voulez mettre en œuvre, j'avoue ne pas avoir compris !!!

Sub AllCombi()
Dim uni@
Dim cen@
Dim dec@
Dim T(1 To 1000, 1 To 4)
Dim cpt&
For uni@ = 1 To 10
  For cen@ = 100 To 109
    For dec@ = 1 To 10
      cpt& = cpt& + 1
      T(cpt&, 1) = uni@
      T(cpt&, 2) = cen@
      T(cpt&, 3) = dec@ / 10
      T(cpt&, 4) = T(cpt&, 1) * T(cpt&, 2) * T(cpt&, 3)
    Next dec@
  Next cen@
Next uni@
Sheets.Add
Range("a1:b1000").NumberFormat = "#0"
Range("c1:d1000").NumberFormat = "#0.0"
Range("a1:d1000") = T
End Sub

Cordialement.

PMO
Patrick Morange

 

[mikeo]

Re : Multiples combinaisons 3 colonnes

Bonjour le forum,

10*10*10 = 1000 combinaisons.
tu peux faire 100 lignes, ou bien 10 tableaux de 10x10 comme je te propose ci-après.
A compléter en faisant attention aux $

A+
M

 

[alan]

Re : Multiples combinaisons 3 colonnes

Merci Patrick et Mikeo,

Patrick, ton code me va bien et le fait de l'avoir sur une autre feuille me facilite la vie. Quant a le rendre plus attractif, mikeo a trouve une solution deja plus "lisible" mais toutes ces formules ne seront pas possibles pour mon projet comme j'ai simplifie l'operation (multiplication) sur cet exemple. Ca sera beaucoup plus complexe dans mon projet donc impossible d'utiliser des formules.
Merci bcp a vous deux dans tous les cas.
Ciao

 

[PMO2]

Re : Multiples combinaisons 3 colonnes

Bonjour Alan et Mikeo,

Grâce à l'exemple de Mikeo voici une deuxième mouture de mon code.
Il fait la même chose mais j'ai ajouté
1) l'attractivité (tableau 3D inspiré par Mikeo)
2) la possibilité d'adapter les différentes boucles (voir les ### dans le code)

Type structData
  Debut As Long
  Fin As Long
  Count As Long
End Type

Sub AllCombi_3D()
Dim Unite As structData
Dim Centaine As structData
Dim Decimale As structData
Dim uni@
Dim cen@
Dim dec@
Dim T()
Dim T2()
Dim S As Worksheet
Dim R As Range
Dim cpt&
Dim g&
Dim i&
Dim j&
Dim k&
Dim Lig&

  '#########################################################
  '### Les Debut et les Fin sont à adapter à votre usage ###
  '#########################################################
'--- Initialisation (Réglages appropriés) ---
With Unite
  .Debut = 1
  .Fin = 10
  .Count = .Fin - .Debut + 1
End With
With Centaine
  .Debut = 100
  .Fin = 109
  .Count = .Fin - .Debut + 1
End With
With Decimale
  '°°° Exprimer des entiers (la conversion en décimale aura lieu plus loin dans le code (/10) °°°
  .Debut = 1
  .Fin = 10
  .Count = .Fin - .Debut + 1
End With
'--------------------------------------------
  '#########################################################
  
ReDim T(1 To Unite.Count * Centaine.Count * Decimale.Count, 1 To 4)
For uni@ = Unite.Debut To Unite.Fin
  For cen@ = Centaine.Debut To Centaine.Fin
    For dec@ = Decimale.Debut To Decimale.Fin
      cpt& = cpt& + 1
      T(cpt&, 1) = uni@
      T(cpt&, 2) = cen@
      T(cpt&, 3) = dec@ / 10
      
          '### Le type d'opération est à adapter ###
      T(cpt&, 4) = T(cpt&, 1) * T(cpt&, 2) * T(cpt&, 3)
          '#########################################
          
    Next dec@
  Next cen@
Next uni@
Set S = Sheets.Add
cpt& = 0
Lig& = 1
For k& = Unite.Debut To Unite.Fin
  Erase T2
  ReDim T2(1 To Centaine.Count + 1, 1 To Decimale.Count + 1)
  For i& = 1 To UBound(T2, 1)
    For j& = 1 To UBound(T2, 2)
          '--- les bordures ---
      If i& = 1 And j& = 1 Then
        T2(i&, j&) = T(1 + ((Centaine.Count * Decimale.Count) * (k& - 1)), 1)
      ElseIf i& > 1 And j& = 1 Then
        T2(i&, j&) = T(((Decimale.Count) * (i& - 1)), 2)
      ElseIf i& = 1 And j& > 1 Then
        T2(i&, j&) = T(1 + ((j& - 2)), 3)
      Else
          '--- les Data ---
        cpt& = cpt& + 1
        T2(i&, j&) = T(cpt&, 4)
      End If
    Next j&
  Next i&
  Set R = S.Range(Cells(Lig&, 1), Cells(Centaine.Count + Lig&, Decimale.Count + 1))
  R = T2
  Lig& = Lig& + R.Rows.Count + 1
  With R
    .Cells.NumberFormat = "#0.0"
    .Columns(1).NumberFormat = "#0"
    .Columns(1).Interior.Color = vbYellow
    .Rows(1).Interior.Color = vbYellow
    .Cells(1, 1).Font.Bold = True
    .Cells(1, 1).HorizontalAlignment = xlCenter
    For g& = 7 To 12
      .Borders(g&).LineStyle = xlContinuous
    Next g&
  End With
Next k&
S.Columns.AutoFit
End Sub

Cordialement.

PMO
Patrick Morange

 

[alan]

Re : Multiples combinaisons 3 colonnes

C'est parfait Patrick, ton code marche au poil!
La structure est sympa pour comparer, on peut voir les donnees de depart...nickel!
Marci beaucoup
alan