Bonjour,
j’ai un questionnaire qui comporte des questions ouvertes et des questions fermées.
je souhaite faire un code VBA qui me trouve toutes les combinaisons possibles sur les questions fermées. Les questions fermées ont des réponses uniques
N° 4 comportes 3 réponses possibles : 4a, 4b,4c
N° 8 comporte 4 réponses possibles : 8a,8b,8c,8d
N° 12 comporte 2 réponses possible : 12a,12b
N° 13 comporte 4 réponses possibles : 13a,13b,13c,13d
N° 14 comporte 5 réponses possible : 14a,14b,14c,14d,14e
N° 15 comporte 2 réponses possibles : 15a ou 15b
N° 16 comporte 2 réponses possibles : 16a,16b
N° 17compote 2 réponses possibles : 17a,17b
N°18 comporte 2 réponses possibles : 18a, 18b
N° 19 comporte 2 réponses possibles : 19a, 19b
N° 20 comporte 2 réponses possibles : 20a, 20b
N° 21 comporte 2 réponses possibles : 21a, 21b
N° 22 comporte 2 réponses possibles : 22a, 22b
N° 24 comporte 3 réponses possibles : 24a, 24b,24c
N° 25 comporte 2 réponses possibles : 25a, 25b
N° 26 comporte 2 réponses possibles : 26a, 26b
N° 27 comporte 2 réponses possibles : 27a, 27b
N° 28 comporte 2 réponses possibles : 28a, 28b
N° 2 comporte 10 réponses possibles : 2a,2b,2c,2d,2e,2f,2g,2i,2j
Il y a des transitions entre les réponses des questions :
4a =>8
4b =>8
4c =>28
8a =>12
8b =>12
8c =>12
8d =>28
12a=>13
12b=>13
13a =>15
13b =>15
13c =>14
13d =>26
14a =>18
14b => 18
14c=>18
14d =>18
14 e=>18
15 a =>16
15b => 16
16a =>17
16b =>17
18a => 20
18b =>19
19a=>25
19b=>28
20a =>22
20b =>25
20c =>23
21a =>28
21b=>25
22a=>28
22b=>25
23=>24
24a=>28
24b=>28
24c=>25
25a=>28
25b=>28
26a=>24
26b=>20
27a=>28
27b=>28
28a =>2a à 2j
28b =>2a à 2j
L’IA m’a aidé à écrire ce code qui fonctionne partiellement, , il s’arrête aux 2 1ère questions (4 et 8) :
Option Explicit
Sub GenerateCombinations()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(« Feuil1 ») ’ Modifier selon la feuille cible
Dim transitions As Object
Set transitions = CreateObject("Scripting.Dictionary")
' Définition des transitions sous forme de dictionnaire
transitions.Add "4a", Array("8a", "8b", "8c", "8d")
transitions.Add "4b", Array("8a", "8b", "8c", "8d")
transitions.Add "4c", Array("28")
transitions.Add "8a", Array("12a", "12b", "12c", "12d")
transitions.Add "8b", Array("12a", "12b", "12c", "12d")
transitions.Add "8c", Array("12a", "12b", "12c", "12d")
transitions.Add "8d", Array("28")
transitions.Add "12a", Array("13a", "13b", "13c", "13d")
transitions.Add "12b", Array("13a", "13b", "13c", "13d")
transitions.Add "13a", Array("15a", "15b")
transitions.Add "13b", Array("15a", "15b")
transitions.Add "13c", Array("14a", "14b", "14c", "14d", "14e")
transitions.Add "13d", Array("26a")
transitions.Add "14a", Array("18a", "18b", "18c", "18d", "18e")
transitions.Add "14b", Array("18a", "18b", "18c", "18d", "18e")
transitions.Add "14c", Array("18a", "18b", "18c", "18d", "18e")
transitions.Add "14d", Array("18a", "18b", "18c", "18d", "18e")
transitions.Add "14e", Array("18a", "18b", "18c", "18d", "18e")
transitions.Add "15a", Array("16a", "16b")
transitions.Add "15b", Array("16a", "16b")
transitions.Add "16a", Array("17a", "17b")
transitions.Add "16b", Array("17a", "17b")
transitions.Add "18a", Array("20a", "20b")
transitions.Add "18b", Array("19a", "19b")
transitions.Add "19a", Array("25a", "25b")
transitions.Add "19b", Array("28")
transitions.Add "20a", Array("22a", "22b")
transitions.Add "20b", Array("25a", "25b")
transitions.Add "20c", Array("23")
transitions.Add "21a", Array("28")
transitions.Add "21b", Array("25a", "25b")
transitions.Add "22a", Array("28")
transitions.Add "22b", Array("25a", "25b")
transitions.Add "23", Array("24a")
transitions.Add "24a", Array("28")
transitions.Add "24b", Array("28")
transitions.Add "24c", Array("25a")
transitions.Add "25a", Array("28")
transitions.Add "25b", Array("28")
transitions.Add "26a", Array("24a", "24b")
transitions.Add "26b", Array("20a", "20b")
transitions.Add "27a", Array("28")
transitions.Add "27b", Array("28")
Dim results As Object
Set results = CreateObject("System.Collections.ArrayList")
Dim queue As Object
Set queue = CreateObject("System.Collections.Queue")
' Ajouter les questions de départ (4a, 4b, 4c)
Dim key As Variant
For Each key In transitions.Keys
If Left(key, 1) = "4" Then
queue.Enqueue key
End If
Next key
' Boucle de génération des combinaisons
Do While queue.count > 0
Dim current As String
current = queue.Dequeue
' Vérifier si cette question a des réponses possibles
If transitions.Exists(current) Then
Dim answers As Variant
answers = transitions(current)
' Ajouter les nouvelles combinaisons
Dim answer As Variant
For Each answer In answers
queue.Enqueue current & "," & answer
Next answer
Else
' Ajouter aux résultats si c'est une combinaison complète
results.Add current
End If
Loop
' Écriture des résultats dans Excel
Dim row As Long
row = 1
Dim i As Long
For i = 0 To results.count - 1
ws.Cells(row, 1).Value = results(i)
row = row + 1
Next i
MsgBox "Génération terminée! Nombre total de combinaisons: " & results.count, vbInformation
End Sub
Pourriez vous m’aider à finaliser un code qui me donnerait toutes les combinaisons possibles ?
en vous remerçiant
Ellen