VBA : parcours en cascade

[dionys0s]

Bonjour le forum,

j'ai un onglet LISTE qui contient des niveaux de classification, avec pour chaque niveau, les valeurs autorisées.
Dans un onglet CHOIX, il est possible de combiner ces niveaux entre entre eux (coche x).

J'aimerais, en fonction de ce qui est coché, parcourir les niveaux de classification en cascade pour isoler chaque combinaison potentielle, qu'il y ait 1, 2 ou 20 niveaux combinés.

Je ne suis pas certain d'être clair, mais je pense que le fichier joint est assez explicite.
En gros, les onglets LISTE et CHOIX ne sont pas à modifier. Il s'agit de remplir le troisième onglet (COMBINAISONS), qui est déjà fait (mais à la main) pour le moment.

Merci d'avance 🙂

 

[dionys0s]

Re : VBA : parcours en cascade

Re,

je fais des recherches du côté des algorithmes de classification, mais pour le moment je vais choux blanc. Quelqu'un en sait plus ?

 

[dionys0s]

Re : VBA : parcours en cascade

On a le droit de "up" ?

 

[PMO2]

Re : VBA : parcours en cascade

Bonjour dionys0s,

Votre demande est-elle toujours d'actualité ?
J'ai commencé à faire un algorithme mais sa finalisation s'avère très compliqué. J'en resterai donc là si vous avez réussi à solutionner votre problème.

 

[dionys0s]

Re : VBA : parcours en cascade

Bonjour PMO2

Je n'ai pas réussi à obtenir ce que je voulais pour le moment.
Je me suis décidé à lire de la littérature sur les algorithmes et la récursivité, mais cela risque de prendre du temps.
Peut-être puis-je aider/contribuer à ton travail et tenter de rattraper mon retard ?

 

[dionys0s]

Re : VBA : parcours en cascade

Bonjour le forum,

j'ai pensé à une solution peut-être un peu moche, non récursive que je vous soumets.
Étant tout à fait nul en classes, j'ai fait ça avec des types personnalisés.
Il y a 3 modules de code, le plus "important" étant "m2_PROG". C'est lui qui contient le code développé spécifiquement pour cette problématique, et la macro qui liste les possibilités de tris croisés à partir des listes est "FindAllKeys".

C'est encore un peu brouillon, pas très propre, mais ça fonctionne.
Je précise que certains champs ne sont pas encore utilisés, comme "PARENT" et "REGLE" dans "TRIS PARENTS", mais qu'ils seront susceptibles de servir assez vite (j'y travaille).

Si vous avez des remarques / suggestions, je suis totalement preneur.

D'avance merci

dionys0s

 

[PMO2]

Re : VBA : parcours en cascade

Bonjour,

Je ne pense pas que ce soit la piste à suivre.
****
J'ai réfléchi à une toute autre approche algorithmique qui traiterait toutes les combinaisons possibles quel que soit le nombre de niveaux. J'essaie de programmer tout cela et j'espère arriver à finaliser.
Je vous tiens au courant.

 

[PMO2]

Re : VBA : parcours en cascade

J'ai réfléchi à une toute autre approche algorithmique qui traiterait toutes les combinaisons possibles quel que soit le nombre de niveaux.

Bonsoir,

Voici donc ma proposition qui, peut être, vous conviendra mieux.
Je l'ai appliquée aux 2 pièces que vous avez jointes et qui ont des structures différentes (de l'une à l'autre, je n'ai changé que les constantes signalées par des ###).
Les combinaisons s'affichent dans une nouvelle feuille.

Code à copier dans un module standard

'### Constantes à adapter ###
Const FEUILLE_CHOIX As String = "CHOIX"
Const FEUILLE_LISTES As String = "LISTES"
Const SEPARATEUR As String = "_"
'############################

'/// Portée au niveau module ///
Dim R1 As Range
Dim R2 As Range
Dim C1 As Range
Dim C2 As Range
Dim Result()
'///////////////////////////////

Sub aa()
Dim S As Worksheet
Dim R As Range
Dim var
Dim Retour
Dim i&
Dim j&
Dim k&
Dim Lig&
Dim A$
Dim T()
'---
Set S = Sheets(FEUILLE_CHOIX)
Set R = S.UsedRange
var = R
Lig& = 1
'---
For i& = 2 To UBound(var, 1)
  A$ = ""
  For j& = 2 To UBound(var, 2)
    If var(i&, j&) = "x" Then
      A$ = A$ & var(1, j&) & SEPARATEUR
    End If
  Next j&
  A$ = Mid(A$, 1, Len(A$) - 1)
  '---
  Retour = GetCombinaisons(A$)
  ReDim Preserve T(1 To 1, 1 To Lig& + UBound(Retour) - 1)
  For k& = 1 To UBound(Retour)
    T(1, Lig&) = Retour(k&)
    Lig& = Lig& + 1
  Next k&
Next i&
'--- Inscription ---
Set S = Sheets.Add
S.Range("a1:a" & UBound(T, 2) & "") = Application.WorksheetFunction.Transpose(T)
End Sub

Private Function GetCombinaisons(A$) As Variant
Dim tempo
Dim i&
Dim k&
Dim cpt&
Dim T()
Dim T2()
'---
ReDim T(0)
tempo = Split(A$, SEPARATEUR)
'---
If UBound(tempo) = 0 Then
  Set R1 = GetRange(A$)
  ReDim T(1 To R1.Rows.Count)
  For Each C1 In R1
    cpt& = cpt& + 1
    T(cpt&) = C1
  Next C1
Else
  For k& = UBound(tempo) To LBound(tempo) Step -1
    If UBound(T) = 0 Then
      Set R2 = GetRange(tempo(k&))
      Set R1 = GetRange(tempo(k& - 1))
      ReDim T(1 To R2.Rows.Count * R1.Rows.Count)
      For Each C1 In R1
        For Each C2 In R2
          cpt& = cpt& + 1
          T(cpt&) = C1 & SEPARATEUR & C2
        Next C2
      Next C1
      k& = k& - 1
    Else
      T2 = T
      Set R2 = GetRange(tempo(k&))
      ReDim T(1 To UBound(T) * R2.Rows.Count)
      cpt& = 0
      For Each C2 In R2
        For i& = 1 To UBound(T2)
          cpt& = cpt& + 1
          T(cpt&) = C2 & SEPARATEUR & T2(i&)
        Next i&
      Next C2
    End If
  Next k&
End If
'---
GetCombinaisons = T
End Function

Private Function GetRange(ByVal Titre As String) As Range
Dim S As Worksheet
Dim R As Range
Dim var
Dim j&
Dim LastLig&
'---
Set S = Sheets(FEUILLE_LISTES)
Set R = S.UsedRange
var = R
For j& = 1 To UBound(var, 2)
  If var(1, j&) = Titre Then
    LastLig& = S.Cells(Application.Cells.Rows.Count, j&).End(xlUp).Row
    Set R = S.Range(S.Cells(2, j&), S.Cells(LastLig&, j&))
    Exit For
  End If
Next j&
Set GetRange = R
End Function

 

[dionys0s]

Re : VBA : parcours en cascade

Bonjour le forum,
Re PMO2

Je regarde ça attentivement et reviens vers vous.
À première vue ceci dit, le résultat est le même non ? La méthode diffère, mais il m'avait bien semblé déduire les même combinaisons. Ou alors quelque chose m'a échappé.

Bien à vous.