Redim Preserve

Bonjour,

Dans cette procédure, j'utilise Dim s(1 To 100) et Dim t(1 To 100, 1 To 1)
car je sais que mes tableaux ne contiendront pas plus de 100 nombres.
Ma question est :
Comment utiliser Redim Preserve pour faire en sorte que les dimensions
de mes tableaux correspondent au nombre de valeurs que la macro va trouver
?
Ça devrait commencer par Dim s() et Dim t(). Par la suite, où dois-je
placer mes Redim Preserve ?

Sub Nombres_De_Keith()
Dim s(1 To 100)
Dim t(1 To 100, 1 To 1)
t1 = Time
For n = 10 To 999999
nc = Len(n)
For i = 1 To nc
s(i) = Mid(n, i, 1)
somme = somme + s(i)
Next i
s(i) = somme
k = nc + 1
Do
k = k + 1
s(k) = 2 * s(k - 1) - 1 * s(k - 1 - nc)
Loop Until s(k) >= n
If s(k) = n Then
j = j + 1
t(j, 1) = n
End If
somme = 0
Next n
Range(Cells(1, 1), Cells(j, 1)).Value = t
MsgBox Format(Time - t1, "hh:mm:ss")
End Sub
Pour savoir si un nombre entier positif de n chiffres ( n >= 2 ) est un
nombre de Keith,
on forme une suite de la manière suivante :

1) Les n premiers nombres de la suite sont les n chiffres du nombre
2) Chaque nombre ajouté dans la suite est la somme des n précédents.

Si un nombre de cette suite est égal au nombre de départ, on vient de
capturer
un nombre de Keith. Par exemple, 14, 197 et 1104 sont des nombres de Keith
:
14 ( n = 2 ) : 1, 4, 5, 9, 14
197 ( n = 3 ) : 1, 9, 7, 17, 33, 57, 107, 197
1104 ( n = 4 ) : 1, 1, 0, 4, 6, 11, 21, 42, 80, 154, 297, 573, 1104

Serge

Bonjour,

Une piste avec votre code modifié ci-dessous


'********************************
Sub PMO_Nombres_De_Keith()
Dim t1 As Date
Dim n As Long
Dim nc As Long
Dim A As String
Dim i As Long
Dim j As Long
Dim k As Long
Dim somme As Long

Dim s() As Long
Dim t() As Long
Dim T2() As Long

t1 = Time
For n = 10 To 999999
A = CStr(n)
nc = Len(A)
For i = 1 To nc
ReDim Preserve s(1 To i)
s(i) = CLng(Mid(A, i, 1))
somme = somme + s(i)
Next i
ReDim Preserve s(1 To i)
s(i) = somme
k = nc + 1
Do
k = k + 1
ReDim Preserve s(1 To k)
s(k) = 2 * s(k - 1) - 1 * s(k - 1 - nc)
Loop Until s(k) >= n
If s(k) = n Then
j = j + 1
ReDim Preserve t(1 To j)
t(j) = n
End If
somme = 0
Next n
'---- Transposition ----
ReDim T2(1 To UBound(t), 1 To 1)
For i = 1 To UBound(t)
T2(i, 1) = t(i)
Next i
'-----------------------
Range("a1:a" & UBound(t) & "") = T2
MsgBox Format(Time - t1, "hh:mm:ss")
End Sub
'********************************

Cordialement.

PMO
Patrick Morange