Discussion :

[mjpmjp]

re,
pour lancer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
'----- appel codage
    LargeurCode = 4
    NombreDeLigne = 5
    LigneTab = 0
    ColLig1 = 1
    ReDim TabResult(0)
    Call Codage("Code2", 1)

@+JP

[Theze]

Bonsoir tout le monde,

Hello Jacques, l'informatique n'est absolument pas ma profession (je suis artisan dans le bâtiment) et je n'ai donc pas ta logique informatique d'où la sortie des rames
Je vais attendre que tu postes ton code et l'éplucher afin de mieux saisir ce que tu me dis !
Amitiés et bonne soirée

[Blaise]

Ce serait là faire en vba une partie du mécanisme Javascript "piqué" sur la toile par le fiston du demandeur

Ah non ! je m'insurge, c'est son oeuvre, il est développeur. Je cherchais une logique, il m'a donné la sienne.

Quant à moi, j'ai d'autres occupations et je ne peux travailler à plein temps dessus. Excusez-moi donc si je mets du temps à vous montrer mon code.

Blaise

[mjpmjp]

bonjour,


@+JP

[Theze]

Bonjour,

Je comprend tout à fait la notion de tableau de tableaux là où je bloque, c'est la concaténation des lettres, je pense qu'une fonction récursive est nécessaire afin d'éviter les multiples boucles que ça demande.
Dans le code ci-dessous, j'utilise des types Utilisateur afin que les dimensions des tableaux soient des propriétés pour une plus simple compréhension.
Je dois allez bosser, je regarderai plus tard pour l'assemblage si j'y arrive :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
 
ype Enfants
    Ligne As Integer
    Colonne As Integer
    Valeur As String
End Type
 
Type Parents
    Ligne As Integer
    Colonne As Integer
    Valeur As String
    Enfant() As Enfants
End Type
 
Sub Test()
 
    Dim Famille() As Parents
    Dim Tbl() As String 'pour la récupération des concaténations
    Dim Plage As Range
    Dim I As Integer
    Dim J As Integer
    Dim K As Integer
    Dim L As Integer
    Dim T1 As Integer
    Dim T2 As Integer
 
    With Worksheets("Feuil1"): Set Plage = .Range(.Cells(1, 1), Cells(5, 3)): End With
 
    'parcours la plage par colonne
    For I = 1 To Plage.Columns.Count
 
        'et chaque colonne par ligne bien sûr !
        For J = 1 To Plage.Rows.Count
 
            If Plage(J, I).Value <> "" Then
 
                'mémorise la position et valeur
                T1 = T1 + 1
                ReDim Preserve Famille(1 To T1)
                Famille(T1).Colonne = I
                Famille(T1).Ligne = J
                Famille(T1).Valeur = Plage(J, I).Value
 
                'idem...
                For K = 1 To Plage.Columns.Count
 
                    For L = J + 1 To Plage.Rows.Count
 
                        If Plage(L, K).Value <> "" Then
 
                            'les frères/enfants
                            T2 = T2 + 1
                            ReDim Preserve Famille(T1).Enfant(1 To T2)
                            Famille(T1).Enfant(T2).Colonne = K
                            Famille(T1).Enfant(T2).Ligne = L
                            Famille(T1).Enfant(T2).Valeur = Plage(L, K).Value
 
                        End If
 
                    Next L
 
                Next K
                T2 = 0
            End If
 
        Next J
 
    Next I
 
    'ici, une fonction récursive afin d'éviter les multiples boucles nécessaires pour assembler les lettres !
    'le contrôle devant être fait sur la valeur de la Colonne afin d'éviter les niveaux parallèles
    '...
    '...
    '...
 
    'pour un test des valeurs dans les tableaux dans la fenêtre d'exécution :
    For I = 1 To UBound(Famille)
 
        Debug.Print Famille(I).Valeur
 
        If Not (Not Famille(I).Enfant) Then
 
            For J = 1 To UBound(Famille(I).Enfant)
 
                Debug.Print " ---"; _
                    IIf(Famille(I).Enfant(J).Colonne = Famille(I).Colonne, "frères", _
                    IIf(Famille(I).Enfant(J).Colonne > Famille(I).Colonne, "enfants", "parent")); _
                    " de "; Famille(I).Valeur; " : "; Famille(I).Enfant(J).Valeur
 
            Next J
 
        End If
 
    Next I
 
End Sub

bonne journée à tout le monde et bonne cogitation !!!

[patricktoulon]

re bonjour
le soucis mjpmjp c'est que ton model démarre en ligne 1 de la plage et garde cet indice alors que tant que 3 caractères peuvent entre pris dans les lignes avant G et D doivent être pris en compte


autrement dis EXEMPLE ICI

E
H B
A C F
Q P R
G
D
LES CODES COMMENCERONT PAR E ou H ou B et même A

SANS COMPTER QUE LE 3 ET 4 EME CARATERES PEUVENT ETRE G et D

DONC SELON SA DEMANDE ET CES EXPLICATION EN IMAGES

ici PAR EXEMPLE
EHPG POUR LE DEPART EN LIGNE 1
ICI PAR EXEMPLE
BCQD POUR LE DEPART EN LIGNE 2
EXEMPLE ICI
ARGD POUR LE DEPART EN LIGNE 3 EN CONSIDERANT QUE G ET D SONT INCLUS

c'est bien pour ca que j'ai dis qu'il fallait une sacrée mécanique

ON EST DONC dans une boucle ligne englobant une seconde boucle ligne ayant pour indice de depart la iteration de la première
puis la boucle sur colonne
et cela pour 4

il faut aussi prévoir une boucle sur 2 puisque G et D peuvent être ensemble dans un même code

je le redis: vous êtes pas sortis l'auberge

[RyuAutodidacte]

Coucou à tous,

Pour l'instant je ne vais pas vous présenter vraiment un code car je ne suis pas encore satisfait du résultat (même si je pense que la logique s'en approche, mais peu être que je me trompe).
Pour moi il y a 2 grandes parties :
- le décalage (que l'on pourrait programmerez façon automatique selon les paramètres choisis)
- les combinaisons aidées par une récursivité

PS : mon tableau principal commence à 1 les Arrays intérieurs commencent à l'indice 0.

Bout de code de départ le reste n'ayant que peu d'importance puisque je n'ai toujours pas ma fonction récursive.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub test7()
Dim i&, h&, Coll As New Collection
    DL = Cells(Rows.Count, 1).End(xlUp).Row
    VA = Application.Transpose(Range("A1:A" & DL).Value)
    For i = LBound(VA) To UBound(VA)
        VA(i) = Split(VA(i), " ")
    Next
 
    For Decaler = 1 To UBound(VA) - (4 - 1)
        For TabArr = 0 + Decaler To 3 + Decaler

La récursivité : je la vois un peu comme dans le Dir dans le sens que au lieu de le faire sur un dossier, je dois le faire sur un array intérieur (au tableau principal) à chaque fois que l'indice total est supérieur à 0, ce qui permettra de créer les combinaisons.
C'est cette partie là qui est délicate car il faudra bien agencé le code de manière à prendre en compte l'ensemble des combinaisons. Le mieux est d'avoir une fonction.

Une fois les combinaisons faites avec les lignes de 1 à 4, on décale de une ligne (de 2 à 5) et on recommence les combinaisons avec la récursivité pour les arrays intérieur dont l'indice total est supérieur à 0

Voilà grosso modo je que je tente de faire (gymnastique de l'esprit rentre dans ma tête stp )

[patricktoulon]

perso voila comment je vois la chose

concaténer tout les caractère avant G et D
ON A ainsi le nombre de code possible avec la puissance
dans un do loop arrété par nombre
prendre rnd*colonne de chaque ligne
prendre que le left 3 EN 2 EXEMPLAIRES ajouter D ET G DANS L UN ET L AUTRE
ATTENTION AUX DOUBLONS UN SIMPLE TEST AVANT D INTEGRER

LE TOUT DANS UNE BOUCLE PRINCIPALE LIGNE BIEN ENTENDU


une fois cela fini reprendre tous et ne garder que le left 2 des items EN 2 EXEMPLAIRES et ajouter G et D POUR LES COMBINAISON AVEC G ET D INCLUS

EDIT/ je precise que l'utilation de le puissance n'est pas le bon mot ici

pour obtenir le nombre de combi possible

chaque ligne et x colonne doivent être multiplier par le nombre de colonne dans la ligne suivante :exepter G et D QUI NE DOIVENT PAS ETRE PRISE EN COMPTE POUR LE CALCUL

EXEMPLE

E
H B4*2=2
A C F *3=6

etc.....

edit
@jacques
non c'est pas aléatoire
rnd avec randomize ne m'a jamais fait default
il est vrai que cela peut variier d'une tentative a l'autre en terme de tour
mais infini non


après boucler par les index te contrains a sur et sou boucler e/ou de répéter soit en récursif soit en double exécution a cause des contraintes que j'ai cité précédemment

[unparia]

Bonjour Patrick
L'aléa étant un aléa et la loi des nombres étant la loi des nombres, la méthode que tu proposes-là pourrait fort bien aboutir dans certains cas (si pas de bol) à un traitement en boucle sans fin...

(outre une autre faille de raisonnement, hein ...)

[mjpmjp]

bonjour,
FINI la récursivité , vend des rétros satanas !!!!

pour le même résultat , voila un code tout beau , tout propre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
 
Dim TabResult() As String
Dim TabCode() As String
Dim TabTmp() As String
Dim LargeurCode As Integer
Dim NombreDeLigne As Integer
Dim ColLig1 As Integer
Dim ColLig2 As Integer
Dim LigneTab As Integer
Dim LigneSchema As Integer
Dim FinCode As Boolean
Dim FinDeCodage As Boolean
 
Private Sub CommandButton1_Click()
    '----- appel codage
    ReDim TabResult(0)
    ReDim TabCode(0)
    ReDim TabTmp(1)
    TabTmp(1) = Cells(1, 1).Value
    LargeurCode = 4
    NombreDeLigne = 5
    ColLig1 = 1
    ColLig2 = 0
    LigneSchema = 2
    FinCode = False
    FinDeCodage = False
    Call Codage
End Sub
Private Sub Codage()
    Do
        ColLig2 = ColLig2 + 1
        If Cells(LigneSchema, ColLig2).Value <> "" Then
            ConstruireCode
        Else
            CopierCode
            TesterLargeurCode
            ChangerDeLigne
            If FinDeCodage Then Exit Do
        End If
    Loop
End Sub
Private Sub ConstruireCode()
    For n = 1 To UBound(TabTmp)
        ReDim Preserve TabCode(UBound(TabCode) + 1)
        TabCode(UBound(TabCode)) = TabTmp(n) & Cells(LigneSchema, ColLig2).Value
    Next n
End Sub
Private Sub CopierCode()
    If Not FinCode Then
        TabTmp = TabCode
        ReDim TabCode(0)
    End If
End Sub
Private Sub TesterLargeurCode()
    If LigneSchema = LargeurCode - 1 Then
        FinCode = True
    ElseIf LigneSchema >= LargeurCode Then
        AjouterNewCode
    End If
End Sub
Private Sub AjouterNewCode()
    FinTabResult = UBound(TabResult)
    ReDim Preserve TabResult(UBound(TabResult) + UBound(TabCode))
    For n = 1 To UBound(TabCode)
        TabResult(FinTabResult + n) = TabCode(n)
    Next n
    ReDim TabCode(0)
End Sub
Private Sub ChangerDeLigne()
    LigneSchema = LigneSchema + 1
    ColLig2 = 0
    If LigneSchema > NombreDeLigne Then FinDeCodage = True
End Sub

@+JP

[RyuAutodidacte]

Je n'achèterai pas tes rétros satanas, ni meme regarderai ton code (pour l'instant) pour avoir l'esprit libre de toute inspiration/création et me remettrai ce soir au travail (la trop de taf)

[unparia]

Salut Ryu

pour avoir l'esprit libre de toute inspiration/création

Ah !!! Que je suis content de lire de telles choses !
Tu ne peux savoir à quel point cela me fait plaisir.
Amitiés, Ryu.

[mjpmjp]

bonjour,
non patricktoulon...pas cette pression

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
 
Dim LargeurCode As Integer
Dim NombreDeLigne As Integer
Dim ColLig1 As Integer
Dim ColLig2 As Integer
Dim LigneDeb As Integer
Dim LigneEnCours As Integer
Dim LigneSchema As Integer
Dim FinCode As Boolean
Dim FinDeCodage As Boolean
Dim TabResult() As String
Dim TabCode() As String
Dim TabTmp() As String
 
Private Sub CommandButton1_Click()
    '----- appel codage
    LargeurCode = 4
    NombreDeLigne = 5
    ColLig1 = 1
    ColLig2 = 0
    LigneDeb = 1
    LigneEnCours = 2
    LigneSchema = LigneEnCours
    FinCode = False
    FinDeCodage = False
    '-----
    ReDim TabResult(0)
    ReDim TabCode(0)
    ReDim TabTmp(1)
    TabTmp(1) = Cells(LigneDeb, ColLig1).Value
    '-----
    Call Codage
End Sub
Private Sub Codage()
    Do
        ColLig2 = ColLig2 + 1
        If Cells(LigneSchema, ColLig2).Value <> "" Then
            ConstruireCode
        Else
            TesterLargeurCode
            CopierCode
            ChangerDeLigne
            If FinDeCodage Then Exit Do
        End If
    Loop
End Sub
Private Sub ConstruireCode()
    For n = 1 To UBound(TabTmp)
        ReDim Preserve TabCode(UBound(TabCode) + 1)
        TabCode(UBound(TabCode)) = TabTmp(n) & Cells(LigneSchema, ColLig2).Value
    Next n
End Sub
Private Sub CopierCode()
    If Not FinCode Then
        TabTmp = TabCode
        ReDim TabCode(0)
    End If
End Sub
Private Sub TesterLargeurCode()
    If UBound(TabCode) > 0 Then
        If Len(TabCode(1)) = LargeurCode Then
            FinCode = True
            AjouterNewCode
        End If
    End If
End Sub
Private Sub AjouterNewCode()
    FinTabResult = UBound(TabResult)
    ReDim Preserve TabResult(UBound(TabResult) + UBound(TabCode))
    For n = 1 To UBound(TabCode)
        TabResult(FinTabResult + n) = TabCode(n)
    Next n
    ReDim TabCode(0)
End Sub
Private Sub ChangerDeLigne()
    ColLig2 = 0
    ControlerStatutCode
End Sub
Private Sub ControlerStatutCode()
    If LigneSchema + 1 > NombreDeLigne Then
        If NombreDeLigne - LigneEnCours + 1 < LargeurCode Then
            'changement de LigneEnCours Impossible
            msg = "changement de LigneEnCours Impossible"
        Else
            LigneEnCours = LigneEnCours + 1
            LigneSchema = LigneEnCours
            ColLig2 = 0
            FinCode = False
            ReDim TabCode(0)
            ReDim TabTmp(1)
            TabTmp(1) = Cells(LigneDeb, ColLig1).Value
        End If
    Else
        LigneSchema = LigneSchema + 1
    End If
End Sub

on passe à la ligne 2 "H" et "B" ... le passage va se faire avec LigneDeb + 1

@+JP

[mjpmjp]

bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
 
Dim LargeurCode As Integer
Dim NombreDeLigne As Integer
Dim ColLig1 As Integer
Dim ColLig2 As Integer
Dim LigneDeb As Integer
Dim LigneEnCours As Integer
Dim LigneSchema As Integer
Dim FinCode As Boolean
Dim FinDeCodage As Boolean
Dim TabResult() As String
Dim TabCode() As String
Dim TabTmp() As String
 
Private Sub CommandButton1_Click()
    '----- appel codage
    LargeurCode = 4
    NombreDeLigne = 5
    ColLig1 = 1
    ColLig2 = 0
    LigneDeb = 1
    LigneEnCours = 2
    LigneSchema = LigneEnCours
    FinCode = False
    FinDeCodage = False
    '-----
    ReDim TabResult(0)
    ReDim TabCode(0)
    ReDim TabTmp(1)
    TabTmp(1) = Cells(LigneDeb, ColLig1).Value
    '-----
    Call Codage
End Sub
Private Sub Codage()
    Do
        ColLig2 = ColLig2 + 1
        If Cells(LigneSchema, ColLig2).Value <> "" Then
            ConstruireCode
        Else
            TesterLargeurCode
            CopierCode
            ChangerDeLigne
            If FinDeCodage Then Exit Do
        End If
    Loop
End Sub
Private Sub ConstruireCode()
    For n = 1 To UBound(TabTmp)
        ReDim Preserve TabCode(UBound(TabCode) + 1)
        TabCode(UBound(TabCode)) = TabTmp(n) & Cells(LigneSchema, ColLig2).Value
    Next n
End Sub
Private Sub CopierCode()
    If Not FinCode Then
        TabTmp = TabCode
        ReDim TabCode(0)
    End If
End Sub
Private Sub TesterLargeurCode()
    If UBound(TabCode) > 0 Then
        If Len(TabCode(1)) = LargeurCode Then
            FinCode = True
            AjouterNewCode
        End If
    End If
End Sub
Private Sub AjouterNewCode()
    FinTabResult = UBound(TabResult)
    ReDim Preserve TabResult(UBound(TabResult) + UBound(TabCode))
    For n = 1 To UBound(TabCode)
        TabResult(FinTabResult + n) = TabCode(n)
    Next n
    ReDim TabCode(0)
End Sub
Private Sub ChangerDeLigne()
    ColLig2 = 0
    ControlerStatutCode
End Sub
Private Sub ControlerStatutCode()
    If LigneSchema + 1 > NombreDeLigne Then
        'test changement de LigneEnCours
        If NombreDeLigne - LigneEnCours + 1 < LargeurCode Then
            'changement de LigneEnCours Impossible
            msg = "changement de LigneEnCours Impossible , nombre de lignes restantes insufisant"
            'test changement de colonne dans ligneDeb ColLig1
            If Cells(LigneDeb, ColLig1 + 1).Value = "" Then
                'changement de colonne impossible
                msg = "changement de colonne Impossible , le cycle de LigneDeb est terminé"
                'test changement de LigneDeb
                LigneDeb = LigneDeb + 1
                If LigneDeb > NombreDeLigne - (LargeurCode - 1) Then
                    FinDeCodage = True
                Else
                    LigneEnCours = 3
                    LigneSchema = LigneEnCours
                    ColLig1 = 1
                    ColLig2 = 0
                    FinCode = False
                    ReDim TabCode(0)
                    ReDim TabTmp(1)
                    TabTmp(1) = Cells(LigneDeb, ColLig1).Value
                End If
            Else
                LigneEnCours = 2
                LigneSchema = LigneEnCours
                ColLig1 = ColLig1 + 1
                ColLig2 = 0
                FinCode = False
                ReDim TabCode(0)
                ReDim TabTmp(1)
                TabTmp(1) = Cells(LigneDeb, ColLig1).Value
            End If
        Else
            LigneEnCours = LigneEnCours + 1
            LigneSchema = LigneEnCours
            ColLig2 = 0
            FinCode = False
            ReDim TabCode(0)
            ReDim TabTmp(1)
            TabTmp(1) = Cells(LigneDeb, ColLig1).Value
        End If
    Else
        LigneSchema = LigneSchema + 1
    End If
End Sub

je vais vérifier avec un tableau plus grand , et je reviens avec un schéma de variable

@+JP

[mjpmjp]

bonjour,
voila la nouvelle grille ( + 1ligne , + 1colonne)


la ligne 1


BUG ligne 2


BUG ligne 3


la colonne 1 des lignes 2 et 3 parait OK

@+JP

[mjpmjp]

re,
ligne 1 : (manque)
"EADZ" "XADZ"
"EFDZ" "XFDZ"
"ECDZ" "XCDZ"

ligne 2 :colonne 1 =ok

ligne 3 : seuls , les derniers codes sont ok
"AGDZ" "FGDZ" "CGDZ"

j'y retourne ...

@+JP

[Blaise]

Bonjour,

Voilà, j'ai un peu de temps libre cette après-midi et je reviens vers vous.

Je n'aurais jamais imaginé que cette discussion allait prendre cette ampleur !
Je suis aussi désolé de ne pas avoir encore apporté une seule pierre à l'édifice, mais je n'en suis qu'à repotasser les modules de classe.

pour info, le tableau de JP
EX
HB
AFC
G
D
Z
Donne 91 combinaisons : https://jsfiddle.net/ob5jzLLf/10/

À+, Blaise

[patricktoulon]

Bonjour blaise
91 combinaisons avec 10 caracteres ,ca veux dire que j'ai raison depuis le debut il y a dans ces combinaisons les ordres et desordre

si on ne devait prendre que les permutations, j'ai pas calculé mais il devrait y avoir environ 25 possibilités tout au plus
comme ce point n'a toujhours pas été eclairci de ta part les autres galoppent

edit:
d'ailleurs je viens de tester ton JS
et en fait il te sort 115 possibilités
tu n'est pas sorti de l'auberge car au vu des resultat c'est meme un peu plus compliqué que ca (ordre et desordre oui mais avec degrevement progressif des item en lignes precedentes

d'autant plus que quand on regarde ton tableau de base on a des plusieurs caracteres dans un meme item
ce qui veux dire que des resultants final seront absents



le mieux c'est que tu nous donne une base avec le resulat complet on comprendra mieux ton souhait je dis bien complet

[Marc-L]

Bonjour !

comme ce point n'a toujhours pas été eclairci de ta part les autres galoppent

Ou ne perdent pas de temps à tenter de répondre, passent directement à la discussion suivante !  

Problème de Nœuds …   au cerveau !

___________________________________________________________________________________________________________
Je suis Paris, Egypte, Nigeria, New-York, Mogadicio, Barcelone, London, Manchester, Stockholm, Istanbul, Berlin, Nice, Bruxelles, Charlie, …

[patricktoulon]

re
ho!! tu sais marc perso ca fait rager un peu mais au fond ca nous fait un peu bosser sur des routines intéréssantes