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 |
Partager