Option Explicit
Sub syracuse()
Dim nombreBase As Long
Dim nombre As Long
Dim tps_vol As Long
Dim tps_vol_altitude As Long
Dim max As Long
Dim cpt& 'compteur du tableau dynamique
Dim T() 'tableau dynamique
'---
nombreBase = Application.InputBox("Saisir un nombre entre 1 et 1000:", "conjecture de syracuse", Type:=1)
If nombreBase < 1 Or nombre > 1000 Then
MsgBox ("saisie incorrecte")
Exit Sub
End If
nombre = nombreBase
max = nombre
tps_vol = 0
'--- D'après ce que j'ai compris (???), il faut
'--- écarter la valeur max. On démarre donc à -1
tps_vol_altitude = -1
Do While nombre <> 1
'### Le tableau dynamique ###
'--- Incrémentation du compteur
cpt& = cpt& + 1
'--- Redimensionnement du tableau dynamique
'--- Il y a 2 dimensions (seule la dernière dimension peut être redimensionnée)
'--- On utilise Preserve pour ne pas écraser l'existant (ce qui a déjà été écrit)
ReDim Preserve T(1 To 2, 1 To cpt&)
'--- Renseigne la 1ère dimension (ligne 1, colonne compteur)
T(1, cpt&) = cpt& 'rang
'--- Renseigne la 2ème dimension (ligne 2, colonne compteur)
T(2, cpt&) = nombre 'nombre
'############################
If nombre Mod 2 = 0 Then
nombre = nombre / 2
tps_vol = tps_vol + 1
Else
nombre = (nombre * 3) + 1
tps_vol = tps_vol + 1
End If
If max < nombre Then max = nombre
If nombre > nombreBase Then tps_vol_altitude = tps_vol_altitude + 1
Loop
'### Inscription du tableau dans une nouvelle feuille ###
Sheets.Add 'Création d'une nouvelle feuille
'--- Comme seule la dernière dimension peut être redimensionnée,
'--- on transpose le tableau (les colonnes tableau deviennent des
'--- lignes Excel, les lignes tableau deviennent des colonnes Excel)
ActiveSheet.Range("a1:b" & cpt& & "") = Application.WorksheetFunction.Transpose(T)
'#########################################################
MsgBox "temps de vol:" & tps_vol & vbNewLine & "altitude maximale:" & max & vbLf & "temps de vol en altitude:" & tps_vol_altitude
End Sub
