Excel to wspaniałe narzędzie. Możemy w nim robić całkiem zaawansowane rzeczy: modele statystyczne, finansowe, symulacje, nawet średnią z kilku liczb jak się dobrze postaramy. No wypas.
Do rysowania piksel po pikselu Excel nadaje się jak pantograf do wyrabiania masła. Da się, ale co się człowiek przy tym namęczy to jego.
Niemniej jednak na niedawną prośbę jednego ze stałych czytelników blogu oto prezentuję WSWAJDMDRSUWE (Wolny, Słabo Wyglądający, Ale Jednak Działający Moduł Do Rysowania Spirali Ulama W Excelu):
Option Explicit
Public Sub Ulam1(ByVal r As String, ByVal maxn As Long)
' r: adres srodka spirali
' maxn: do ilu liczymy
Dim n As Long ' aktualna liczba (1..maxn)
Dim k As Integer ' dlugosc aktualnej krawedzi
Dim dx As Integer, dy As Integer ' kierunek kolejnego kroku; dx w poziomie, dy w pionie (dodatnie: prawo-gora, ujemne: lewo-dol)
Dim i As Long ' skrypt bez i jest jak ryba bez roweru
Dim sh As Excel.Range ' sh od "snake head" czyli robocza komorka w ktorej aktualnie jestesmy
Set sh = Range(r) ' zaczynamy od srodka
dx = 0 'zaczynamy od ruchu w gore
dy = 1
k = 1 'o jeden krok
ThisWorkbook.ActiveSheet.Cells.Clear
ActiveWindow.Zoom = 10
ThisWorkbook.ActiveSheet.Cells.ColumnWidth = 5
ThisWorkbook.ActiveSheet.Cells.RowHeight = 24
Do While n < = maxn
For i = 1 To k
sh.Value = n
If CzyPierwsza(n) Then
sh.Interior.Color = RGB(0, 0, 0)
sh.Font.Color = RGB(255, 255, 255)
Else
sh.Interior.Color = RGB(255, 255, 255)
sh.Font.Color = RGB(0, 0, 0)
End If
n = n + 1
If n Mod 100 = 0 Then DoEvents
Set sh = sh.Offset(-dy, dx)
Next i
' koniec krawedzi - zakrecamy
If dx = 0 And dy = 1 Then 'gora=>prawo
dx = 1
dy = 0
ElseIf dx = 0 And dy = -1 Then ' dol=>lewo
dx = -1
dy = 0
ElseIf dx = 1 And dy = 0 Then ' prawo=>dol, krawedz + 1
dx = 0
dy = -1
k = k + 1
ElseIf dx = -1 And dy = 0 Then ' lewo=>gora, krwedz + 1
dx = 0
dy = 1
k = k + 1
Else ' cos sie spiertenteges
MsgBox "!", vbOKOnly + vbExclamation
End
End If
Loop
End Sub
Public Function CzyPierwsza(ByVal n As Long) As Boolean
If n < 2 Then
CzyPierwsza = False
ElseIf n = 2 Or n = 3 Then CzyPierwsza = True
ElseIf n Mod 2 = 0 Then
CzyPierwsza = False
ElseIf n Mod 3 = 0 Then
CzyPierwsza = False
ElseIf n Mod 5 = 0 Then
CzyPierwsza = False
ElseIf n Mod 7 = 0 Then
CzyPierwsza = False
ElseIf n Mod 11 = 0 Then
CzyPierwsza = False
ElseIf n Mod 13 = 0 Then
CzyPierwsza = False
ElseIf n Mod 17 = 0 Then
CzyPierwsza = False
ElseIf n Mod 19 = 0 Then
CzyPierwsza = False
ElseIf n Mod 23 = 0 Then
CzyPierwsza = False
ElseIf n Mod 29 = 0 Then
CzyPierwsza = False
ElseIf n Mod 31 = 0 Then
CzyPierwsza = False
ElseIf n Mod 37 = 0 Then
CzyPierwsza = False
ElseIf n Mod 41 = 0 Then
CzyPierwsza = False
ElseIf n Mod 43 = 0 Then
CzyPierwsza = False
ElseIf n Mod 47 = 0 Then
CzyPierwsza = False
Else
Dim p As Integer ' pierwiastek
p = Sqr(n) + 1
Dim i As Integer
For i = 53 To p Step 2
If n Mod i = 0 Then
CzyPierwsza = False
Exit Function
End If
Next i
CzyPierwsza = True
End If
End Function
Ponieważ jestem leniwy, nie będę tu omawiał całego skryptu. Dodam tylko, że nieelegancka jest nie tylko pętla główna, ale również metoda sprawdzania pierwszości liczb (od 2 do 2207 mamy zakodowane na stałe sito Eratostenesa, powyżej tego po prostu sprawdzamy podzielność przez kolejne nieparzyste od 53 w górę aż do pierwiastka ze sprawdzanej liczby). Jednak skrypt jakimś cudem działa, więc chociaż trochę się wstydzę, to jednak go tu prezentuję.
Efekt końcowy (dla 10000 elementów) wygląda tak:
Dla 50000 – tak:
(przeskalowane 50% w dół)
A tu 230000 (więcej zasadniczo nie ma sensu, bo się nie mieści na ekranie):
