Concaténation de codes

[SVri]

Bonjour,

j'ai une série de codes que je dois concaténer pour lister toutes les valeurs possibles:

Code1 Code2 Code3 Code4
FLO C1 RECT D100
C2 CINT D110
C3 D120
C4 D130
D140
D150

Ca doit me donner:
FLOC1RECTD100; FLOC1RECTD110; FLOC1RECTD120; ...; FLOC1CINTD100; FLOC1CINTD110; ...; FLOC3RECTD100; etc ...

Afin de m'éviter une longue saisie, j'essaie de trouver le code VBA qui va bien, mais j'ai le cerveau fondu, aujourd'hui ... A l'aide !

Merci aux XLDien(ne)s!

 

[SVri]

Cf le fichier joint: la liste de codes ressemble à quelque chose !!

 

[Mytå]

salut SVri

essaye ceci
Sub all()
rang = 1
Dim code1(1)
Dim code2(4)
Dim code3(2)
Dim code4(6)
code1(1) = "FLO"
code2(1) = "C1"
code2(2) = "C2"
code2(3) = "C3"
code2(4) = "C4"
code3(1) = "RECT"
code3(2) = "CINT"
code4(1) = "D100"
code4(2) = "D110"
code4(3) = "D120"
code4(4) = "D130"
code4(5) = "D140"
code4(6) = "D150"
For a = 1 To 1
For b = 1 To 4
For c = 1 To 2
For d = 1 To 6
Cells(rang, 1).Value = code1(a) & code2(b) & code3(c) & code4(d)
rang = rang + 1
Next d
Next c
Next b
Next a
End Sub

Resultat 48 codes differents

Mytå esperant cela tu voulais

 

[Mytå]

Re Svri

oups j'ai peut-etre mal compris ta question la mais bon essaye qd meme j'avais pas le fichier joint tout a l'heure

Mytå

 

[SVri]

Salut Mytå,

Je pense que c OK avec le code que tu m'as passé.

Je vais tester ça, mais vu d'ici, ça y ressemble bien !!

(je posterais ici le code complet dès que ça marche ...)

merci !!

 

[SVri]

Comme promis, voici le code pour concaténer une série de codes et composer ttes les variantes possibles.

Il faut 2 feuilles: "PARAM" pour les listes de codes, et "RESULT" pour le résultat.

Peut-être qu'un jour dans 1000 ou 2000 ans, ça pourra servir à qqun d'autre ;-)

A+
SVri


Sub CreeCodes()

Dim NbParam, VarI, VarJ, VLig, Lig, Test As Integer
Dim Code, MarqueurFin As String

'=====================================================================
MarqueurFin = "FIN" ' <== marqueur de fin de liste ou dernier param.=
'=====================================================================
NbParam = 0

' ===== Recherche le Nb de paramètres à prendre en compte =====
' (Limité à 8 params)
Sheets("PARAM").Activate
For VarI = 1 To 9
If Cells(2, VarI).Value = "FIN" Then NbParam = VarI - 1: Exit For
Next VarI

' ===== recherche le nb de valeurs pour chq paramètre =====
Dim LongParam(8)
For VarI = 1 To NbParam
For VarJ = 2 To 1000
If Cells(VarJ, VarI).Value = MarqueurFin Then LongParam(VarI) = VarJ - 2: Exit For
Next VarJ
Next VarI

' met 1 dans la long. des params non utilisés de façon à passer ds la boucle finale
For i = NbParam + 1 To 8
LongParam(i) = 1
Next i

' ici, obligé de donner une longueur par défaut, ce ne peut pas être une variable (??!)
Dim Param1(100)
Dim Param2(100)
Dim Param3(100)
Dim Param4(100)
Dim Param5(100)
Dim Param6(100)
Dim Param7(100)
Dim Param8(100)

' ===== Alimente les tableaux avec les valeurs trouvées, pour chq paramètre =====
For VarI = 1 To LongParam(1)
Param1(VarI) = Cells(VarI + 1, 1).Value
If Param1(VarI) = MarqueurFin Then Param1(VarI) = ""
Next VarI
For VarI = 1 To LongParam(2)
Param2(VarI) = Cells(VarI + 1, 2).Value
If Param2(VarI) = MarqueurFin Then Param2(VarI) = ""
Next VarI
For VarI = 1 To LongParam(3)
Param3(VarI) = Cells(VarI + 1, 3).Value
If Param3(VarI) = MarqueurFin Then Param3(VarI) = ""
Next VarI
For VarI = 1 To LongParam(4)
Param4(VarI) = Cells(VarI + 1, 4).Value
If Param4(VarI) = MarqueurFin Then Param4(VarI) = ""
Next VarI
For VarI = 1 To LongParam(5)
Param5(VarI) = Cells(VarI + 1, 5).Value
If Param5(VarI) = MarqueurFin Then Param5(VarI) = ""
Next VarI
For VarI = 1 To LongParam(6)
Param6(VarI) = Cells(VarI + 1, 6).Value
If Param6(VarI) = MarqueurFin Then Param6(VarI) = ""
Next VarI
For VarI = 1 To LongParam(7)
Param7(VarI) = Cells(VarI + 1, 7).Value
If Param7(VarI) = MarqueurFin Then Param7(VarI) = ""
Next VarI
For VarI = 1 To LongParam(8)
Param8(VarI) = Cells(VarI + 1, 8).Value
If Param8(VarI) = MarqueurFin Then Param8(VarI) = ""
Next VarI


' ===== BOUCLE FINALE =====
' ===== Ecrit le résultat dans Result =====
Lig = 1
Sheets("RESULT").Activate
For a = 1 To (LongParam(1))
For b = 1 To (LongParam(2))
For c = 1 To (LongParam(3))
For d = 1 To (LongParam(4))
For e = 1 To (LongParam(5))
For f = 1 To (LongParam(6))
For g = 1 To (LongParam(7))
For h = 1 To (LongParam(8))
Cells(Lig, 1).Value = Param1(a) & Param2(b) & Param3(c) & Param4(d) & Param5(e) & Param6(f) & Param7(g) & Param8(h)
Lig = Lig + 1
Next h
Next g
Next f
Next e
Next d
Next c
Next b
Next a

MsgBox ("Terminé !!" & Chr(13) & Lig - 1 & " Codes créés!")
End Sub