AW: Anzahl Teiler - VBA
10.05.2013 17:13:22
Erich
Hi Erhard,
in den Funktionen AnzTeiler und AnzTeilerOK war ein Fehler - die Schleife lief nicht weit genug,
weil das "-1" beim To falsch positioniert war.
Hier die korrigierten Fassungen:
Function AnzTeilerOK(zz, kk) As Boolean ' kk = vorgegebene Anzahl aller Teiler-2
Dim ii As Long, nn As Byte
For ii = 2 To Fix(Sqr(zz - 1))
If zz Mod ii = 0 Then nn = nn + 2
Next ii
nn = nn - (Sqr(zz) = Fix(Sqr(zz)))
AnzTeilerOK = nn = kk
End Function
Function AnzTeiler(zz) As Long
Dim ii As Long, nn As Byte
For ii = 2 To Fix(Sqr(zz - 1))
If zz Mod ii = 0 Then nn = nn + 2
Next ii
nn = nn - (Sqr(zz) = Fix(Sqr(zz)))
AnzTeiler = nn
End Function
Function AnzTeilerOK2(zz, kk) As Boolean ' kk = vorgegebene Anzahl aller Teiler-2
AnzTeilerOK2 = AnzTeiler(zz) = kk
End Function
Sub Kreuzz()
Dim a&, z%, t!, arrE() As Long
t = Timer
Cells.ClearContents
ReDim arrE(1 To 199999 - 100000 + 1)
For a = 100000 To 199999
' If AnzTeilerV(a, 5) Then ' ist langsam
If AnzTeilerOK2(a, 5) Then
' If AnzTeilerOK(a, 5) Then
z = z + 1
arrE(z) = a
End If
Next a
ReDim Preserve arrE(1 To z)
Cells(1, 1).Resize(z) = Application.Transpose(arrE)
Columns(1).AutoFit
MsgBox Round(Timer - t, 1)
End Sub
Noch ein Tipp: Das "Columns(1).AutoFit" habe ich hinter die Schleife verschoben, das muss nur einmal laufen.
Ich wünsch dir und allen ein schönes Wochenende!
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich