[WD-2010] [Nombres] Renvoyer le plus petit de trois nombres [Résolu]

[Corvvin]

Bonjour,

Encore une question d'apparence élémentaire, et qui me plonge dans des abîmes de perplexité.

J'ai trois variables Integer modifiables dans une boucle, et je dois à chaque tour renvoyer la plus petite d'entre elles, à condition qu'elle ne soit pas nulle.

Or, je n'ai pas trouvé d'autre solution que de passer en revue tous les cas de figure un à un.

D'une part, Je suis étonné qu'il n'existe pas une fonction ou autre propriété des nombres qui permette d'avoir le résultat en un tour de main.
D'autre part j'envisage d'ajouter d'autres variables à cette liste, et ma méthode, déjà peu élégante, va vite devenir fort lourde à appliquer.

Voici une version démo de la procédure :

Code :

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
Sub plusPetitNombre()
 
    Dim chaîne As String
    Dim position As Integer, longueur As Integer
    Dim e As Integer, t As Integer, a As Integer, i As Integer
 
    chaîne = "nous z'irons tsoin-tsoin vers l'avictoire zim-boum"
    longueur = Len(chaîne)
 
    i = 1
 
    Do
        e = InStr(i, chaîne, " ")
        t = InStr(i, chaîne, "-")
        a = InStr(i, chaîne, "'")
 
        If e > 0 And a > 0 And t > 0 Then
            If e < a And e < t Then position = e
            If a < e And a < t Then position = a
            If t < a And t < e Then position = t
        End If
 
        If e = 0 And a > 0 And t > 0 Then
            If t < a Then position = t
            If a < t Then position = a
        End If
 
        If a = 0 And e > 0 And t > 0 Then
            If t < e Then position = t
            If e < t Then position = e
        End If
 
        If t = 0 And a > 0 And e > 0 Then
            If e < a Then position = e
            If a < e Then position = a
        End If
 
        If e = 0 And t = 0 And a > 0 Then position = a
        If e = 0 And t > 0 And a = 0 Then position = t
        If e > 0 And t = 0 And a = 0 Then position = e
        If e = 0 And t = 0 And a = 0 Then position = 0
 
        If position = 0 Then
               Exit Do
        Else
            i = position + 1
          message = MsgBox("e = " & e & vbCr & "a = " & a & vbCr & "t = " & t & vbCr & vbCr & _
            "position = " & position, vbOKCancel)
                If message = vbCancel Then Exit Sub
        End If
    Loop Until i >= longueur
 
    message = MsgBox("e = " & e & vbCr & "a = " & a & vbCr & "t = " & t & vbCr & vbCr & _
            "position = " & position, vbOKCancel)
End Sub

Si vous avez une idée pour simplifier tout ça, elle sera la bienvenue.

Merci

[Sepia]

Salut Corvvin,

Je pense que tu es dans le cas d'un problème d'une pesée en un minimum de coups. Tu as 3 entiers naturels, A, B et C dont tu recherches la valeur minimale non nulle (en regardant ton code, on voit que si A = B = C = 0 alors on doit renvoyer 0). Voici un algo en pseudo-code :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
   SI A <= B
    |   ALORS
    |    |   SI A <= C
    |    |    |   ALORS
    |    |    |    |   SI A > 0
    |    |    |    |    |   ALORS
    |    |    |    |    |    |   RETOURNE A
    |    |    |    |    |   SINON
    |    |    |    |    |    |   SI B <= C
    |    |    |    |    |    |    |   ALORS
    |    |    |    |    |    |    |    |   SI B > 0
    |    |    |    |    |    |    |    |    |   ALORS
    |    |    |    |    |    |    |    |    |    |   RETOURNE B
    |    |    |    |    |    |    |    |    |   SINON
    |    |    |    |    |    |    |    |    |    |   RETOURNE C
    |    |    |    |    |    |    |    |   FSI
    |    |    |    |    |    |   FSI
    |    |    |    |   FSI
    |    |   FSI
   FSI

En fait comme 0 est une solution si A = B = C = 0 alors l'algo fonctionne dans tous les cas.

@+

[Heureux-oli]

Salut,

Ou utiliser un tri à bulles.

http://algo.developpez.com/sources/?page=tri

Ou utiliser un tableau dans un nouveau document, faire un tri du tableau avec la fonction de tri et prendre la première valeur si le tri est ascendant.

[Corvvin]

Merci les amis,

La solution proposée par Heureux-Oli d'utiliser un tableau dans Word et d'y appliquer la méthode Sort fonctionne certainement. J'avoue cependant qu'avant de créer un document pour résoudre un problème de code, j'essaye toujours de voir s'il n'y a pas une solution "autonome" en VBA.

Dans ce but, d'ailleurs, j'avais déjà essayé le tri à bulle, mais... je n'y suis pas arrivé. Il y a toujours un cas qui est "oublié"... Néanmoins, je vais revoir de nouveau la question grâce aux sources algorithmes de ce lien, fort intéressant.

La suggestion de Sepia rejoint ma démarche. En fait, j'ai commencé de cette façon, mais pour traiter tous les cas, j'ai dû à chaque fois en rajouter.

Je joints de nouveau la procédure, modifiée avec l'algo proposé :

Code :

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
Sub lePlusPetitNombre2()
 
    Dim chaîne As String
    Dim position As Integer, longueur As Integer
    Dim e As Integer, t As Integer, a As Integer, i As Integer
 
    chaîne = "nous z'irons tsoin-tsoin vers l'avictoire zim-boum"
    longueur = Len(chaîne)
 
    i = 1
 
    Do
        a = InStr(i, chaîne, " ")
        b = InStr(i, chaîne, "-")
        c = InStr(i, chaîne, "'")
 
        '--------------------------- ALGORITHME -------------------------
 
        If a <= b Then
            If a <= c Then
                If a > 0 Then
                    position = a
                Else
                    If b <= c Then
                        If b > 0 Then
                            position = b
                        Else
                            position = c
                        End If
                    End If
                End If
            End If
        End If
 
        '----------------------------------------------------
 
        If position = 0 Then
               Exit Do
        Else
            i = position + 1
          message = MsgBox("a = " & a & vbCr & "b = " & b & vbCr & "c = " & c & vbCr & vbCr & _
            "position = " & position, vbOKCancel)
                If message = vbCancel Then Exit Sub
        End If
    Loop Until i >= longueur
 
    message = MsgBox("a = " & a & vbCr & "b = " & b & vbCr & "c = " & c & vbCr & vbCr & _
            "position = " & position, vbOKCancel)
End Sub

Tel quel, on ne parvient pas au résultat. Il faut je pense rajouter quelques Else. J'avais renoncé finalement à l'accumulation d'alternatives, car on y arrivait autrement, mais peut-être que ça vaut la peine de continuer dans cette voie.

Si j’obtiens quelque chose, d'une façon ou d'une autre, je le communiquerai.

Merci encore.

[Corvvin]

Bonjour,

Voici comme promis une solution qui semble fonctionner.

Je n'ai pu appliquer directement les algo sources de Romuald Perrot, mais j'en ai retenu (sinon parfaitement compris) certains principes.

Voici le résultat. J'ai ajouté une variable pour pousser un peu le test :

Code :

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
Sub lePlusPetitNombre3()
    On Error Resume Next
 
    Dim chaîne As String
    Dim position As Integer, longueur As Integer
    Dim a As Integer, b As Integer, c As Integer, d As Integer, i As Integer, somme As Integer
    Dim T(4) As Integer, x As Integer, y As Integer, z As Integer, n As Integer
    Dim texte As String ' (uniquement pour la démo)
 
    chaîne = "nous z'irons, tsoin-tsoin, vers l'avictoire, zim-boum !"
    longueur = Len(chaîne)
 
    i = 1
 
    Do
        a = InStr(i, chaîne, " ")
        b = InStr(i, chaîne, "-")
        c = InStr(i, chaîne, "'")
        d = InStr(i, chaîne, ",")
 
        '-------------------------------- T R I ------------------------------
 
        T(1) = a    ' Le tableau T() est déclaré en tête de procédure
        T(2) = b
        T(3) = c
        T(4) = d
        n = 4       ' Indice maximum du tableau (variable pour le principe)
 
        somme = 0
        For x = 1 To n
            If T(x) = 0 Then texte = " (non nul) "      '(uniquement pour la démo)
            somme = somme + T(x)                        ' Reste nul si tous les InStr sont nuls
            If x = n And somme = 0 Then position = 0: texte = "": Exit For
            For y = 1 To n - x                          ' comparaison "ascendante"
                If T(y) > 0 Then
                    If T(y) < T(y + 1) Then pos1 = T(y) Else pos1 = T(y + 1)
                    If T(y + 1) = 0 Then pos1 = T(y)
                End If
            Next y
            For z = x + 1 To n                          ' comparaison "descendante"
                If T(z) > 0 Then
                    If T(z) < T(z - 1) Then pos2 = T(z) Else pos2 = T(z - 1)
                    If T(z - 1) = 0 Then pos2 = T(z)
                End If
            Next z
        If pos1 < pos2 And pos1 > 0 Then position = pos1 Else position = pos2
        If pos2 = 0 Then position = pos1                ' synthèse des comparaisons
        Next x
 
        pos2 = 0
        pos1 = 0
 
        '--------------------------------------------------------------------
 
        If position = 0 Then
               Exit Do
        Else
            i = position + 1
          message = MsgBox("a = " & a & vbCr & "b = " & b & vbCr & "c = " & c & vbCr & "d = " & d & vbCr & vbCr & _
            "Minimum" & texte & " : " & position, vbOKCancel, "Message de boucle")
                If message = vbCancel Then Exit Sub
        End If
    Loop Until i > longueur
 
    message = MsgBox("a = " & a & vbCr & "b = " & b & vbCr & "c = " & c & vbCr & "d = " & d & vbCr & vbCr & _
            "Minimum" & texte & " : " & position, vbOKCancel, "Message de fin")
End Sub

Cela reste un peu compliqué, mais cela devrait s'adapter quelque soit le nombre de variables. Il suffit de les ajouter au tableau.

Noter que la difficulté vient de ce qu'on exclue les valeurs minimales lorsqu'elles sont nulles. Sans cela, l'algorithme serait beaucoup plus simple.

Je reste ouvert à toutes suggestions.

Encore merci de votre aide.

[Corvvin]

Certains, arrivés sur ce topic à cause de l'intitulé principal, peuvent être déçus de ne pas y trouver la réponse à la question telle qu'elle y est résumée (un peu abusivement).

Voici donc le moyen d'obtenir le plus petit d'une liste de nombres, qu'il soit nul ou pas, grâce au lien d'un heureux (au lit) :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub LeVraimentPlusPetitNombre()
 
    Dim T, n As Integer
    T = Array(10, 79, 264, 130, 2, 4378, 12, 67)
    n = UBound(T)
 
    For i = 0 To n
        For j = 0 To n - 1 - i
            If T(j) > T(j + 1) Then T(j) = T(j + 1)
        Next j
    Next i
 
    MsgBox "Minimum : " & T(j)
End Sub

Bien plus simple, n'est-ce pas ?

Noter que les limites du compteur j sont différentes de celles de son équivalent y du code précédent, car ce tableau est créé avec la fonction Array, qui, par défaut, indexe les éléments à partir de zéro.

Merci de votre attention.

Au revoir