Pchełki VBA: rysujemy spiralę Ulama w Excelu

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):