Problem zum Wochenende
alifa
Es sollen die einstelligen Quersummen aller Zahlen von 1 bis 1000000 addiert werden. Mein Makro schafft das, doch nur in 16 Etappen, da es nur 65536 Zeilen gibt. Könnte man das Makro ändern, in dem Sinne, dass die Summe direkt, und nicht über Tabelle berechnet wird? Bin dankbar für jede Hilfe.
Gruß, Erhard
Option Explicit
'Es sollen alle einstelligen Quersummen der Zahlen 1 bis 1000000 addiert werden.
' Z.B. 123564=>1+2+3+5+6+4=21=>1+2=3.
'bei dieser Zahl wird die 3 addiert. Oder bei 999999=>54=>9 wird die 9 addiert.
Sub Einfach()
Dim n&, a&, b&, c&, z&, lngRes&, t!
t = Timer
For n = 65000 To 130000
a = Quersumme(n)
If a > 9 Then b = Quersumme(a)
If b > 9 Then c = Quersumme(b)
If b > 9 Then b = 0
If a > 9 Then a = 0
If a 0 Then b = 0
If b 0 Then c = 0
Cells(z + 1, 1) = a
Cells(z + 1, 2) = b
Cells(z + 1, 3) = c
Cells(z + 1, 4) = WorksheetFunction.Sum(Range("A:A"))
Cells(z + 1, 5) = WorksheetFunction.Sum(Range("B:B"))
Cells(z + 1, 6) = WorksheetFunction.Sum(Range("C:C"))
z = z + 1
Next
MsgBox "Fertig nach " & Round(Timer - t, 2) & " Sekunden"
End Sub
Public Function Quersumme(ByVal Zahl As Long) As Long
Dim nQuersumme As Long
Do While Zahl 0
nQuersumme = nQuersumme + (Zahl Mod 10)
Zahl = Zahl \ 10
Loop
Quersumme = nQuersumme
End Function