Macro pour quadrillage

Bonjour,

je souhaiterai créer une matrice qui contient toutes les combinaisons vérifiant les contraintes suivantes :

- x est le nombre de colonne (x est choisit par l'utilisateur)
- 1 point de la matrice est compris entre 0 et 1 avec un pas donné (imposé par l'utilisateur)
- la somme de tous les points d'une même ligne doit être égale exactement à 1

Par exemple, j'aimerai que quadri(4, 0.5) où x = 4 et pas = 0.5 devra donner le résultat :
1      0      0       0
0.5   0.5   0       0
0      1      0       0
0.5   0      0.5    0
0      0.5   0.5    0
0      0      1       0
0.5   0      0       0.5
0      0.5   0       0.5
0      0      0.5    0.5
0      0      0       1

ou quadri (3,0.25) devra donner le résultat :
1          0          0         
0.75     0.25     0         
0.5       0.5       0
0.25     0.75     0
0          1          0
0.75     0          0.25
0.5       0.25     0.25
0.25     0.5       0.25
0          0.75     0.25
0.25     0.25     0.5
0.5       0          0.5
0          0.5       0.5
0.25     0          0.75
0          0.25     0.75
0          0          1

Je pense qu'il faut utiliser une macro récursive mais je n'arrive pas à la construire. Pouvez-vous m'aider ?

Salut
Problème amusant ... et casse tête.
Je me suis essayé.
Voilà le code que j'ai pondu pour trouver les combinaisons de base.
Il ne te reste qu'à créer les combinaisons suivantes qui ne sont que des mélanges de celles de base.
Colle ce code dans un nouveau projet pour l'essayer.

Nota : Tu as posté ta question dans la catégorie VB6, je te fournis donc un programme en VB6
Comme tu parles de "macro", il y a fort à parier que tu travailles sous Excel, Word ou Access.
La syntaxe est la même - Adapte-le

---

Option Explicit
   
Private Type monType
    Col() As Single
End Type
Private maMatrice() As monType
Private IndexMatrice As Long
Private mesCol() As Single

---

Private Sub Form_Load()

    Dim NbColonnes As Integer
    Dim Pas As Single
    Dim r As Integer
    Dim t As Single
   
    NbColonnes = 4   ' \  Les deux paramètres
    Pas = 0.25            ' /
    
    ' Initialise la matrice
    IndexMatrice = 1
    ReDim maMatrice(1 To IndexMatrice)
   
    ' Recherche les combinaisons de base
    t = 1
    Do While t >= 0.5
        ' Initialise la ligne en cours
        ReDim mesCol(1 To NbColonnes)
        ' Donnée de départ
        mesCol(1) = t
        Call CalculeSuivants(1, Pas, 2, NbColonnes)
        ' Décrémente la 1ere colonne
        t = t - Pas
        DoEvents
    Loop
    ' Supprime la dernière ligne qui est vide
    IndexMatrice = IndexMatrice - 1
    ReDim Preserve maMatrice(1 To IndexMatrice)
    ' Affiche les résultats
    Debug.Print "----------------------------"
    Debug.Print IndexMatrice; " lignes de base :"
    For r = 1 To IndexMatrice
        For t = 1 To NbColonnes
            Debug.Print maMatrice(r).Col(t),
        Next t
        Debug.Print
    Next r
   
    Unload Me
   
End Sub

---

Private Sub CalculeSuivants(ByVal ValeurDépart As Single, _
                            ByRef Pas As Single, _
                            ByVal IndexDépart As Integer, _
                            ByRef IndexMax As Integer)

    ' Sub qui s'appelle elle-même - attention aux modifs
    
    Dim r As Integer
    Dim s As Single
   
    ' Recalcule la somme actuelle
    For r = 1 To (IndexDépart - 1)
        s = s + mesCol(r)
    Next r
    DoEvents
    Select Case (s + ValeurDépart)
        Case 1      ' On est arrivé au bout
            ' Mémorise cette dernière valeur
            mesCol(IndexDépart) = ValeurDépart
            ' Mémorise cette ligne
            maMatrice(IndexMatrice).Col = mesCol
            ' Prépare la ligne de matrice suivante
            IndexMatrice = IndexMatrice + 1
            ReDim Preserve maMatrice(1 To IndexMatrice)
            ' Si la valeur actuelle n'est pas le mini
            If (ValeurDépart - Pas) >= 0 Then
                ' On recommence avec valeur inférieure sans changer d'index
                Call CalculeSuivants(ValeurDépart - Pas, Pas, IndexDépart, IndexMax)
            End If
           
        Case Is < 1     ' On insère et on continue
            ' Mémorise cette dernière valeur
            mesCol(IndexDépart) = ValeurDépart
            ' Recherche valeur suivante (index suivant)
            If IndexDépart < IndexMax Then
                Call CalculeSuivants(ValeurDépart, Pas, IndexDépart + 1, IndexMax)
            End If
       
        Case Is > 1     ' Perdu
            ' Teste valeur plus petite (sans changer d'index)
            If (ValeurDépart - Pas) >= 0 Then
                Call CalculeSuivants(ValeurDépart - Pas, Pas, IndexDépart, IndexMax)
            End If
    End Select

End Sub

---

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

---

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

Bonjour,
 en effet c'est un vrai casse-tête et je n'arrive pas à m'en sortir.
Tout d'abord je tiens à vous remercier pour votre aide. Vous avez du passer pas mal de temps sur cet algorithme et je vous en remercie vivement.

Lorsque je fais tourner votre programme j'ai un message d'erreur sur la ligne Upload Me donc je l'ai mise en commentaire.

Lorsque je le teste ensuite avec les paramètres 4 et 0.5, j'ai la matrice

1	0	0	0
0.5	0.5	0	0

et lorsque je le teste ensuite avec les paramètres 3 et 0.25, j'ai la matrice

1	0	0
0.75	0.25	0
0.5	0.5	0
0.5	0.25	0.25

Il manque des cas. J'ai essayé de comprendre comment fonctionner votre programme pour l'adapter mais je n'y arrive pas. J'ai beaucoup de mal avec les fonctions récursives qui s'appelle elle-même.

Pouvez-vous m'aider ?