在Excel中生成质数螺旋的VBA宏代码

        EXCEL中的宏实在是太好玩啦,写了一个能生成质数螺旋(世界真奇妙啊)的宏,运行效果如下图。

        先选中一个中心格子,然后运行宏,就会从中心开始生成质数螺旋,当中心单元格是空时,就从1开始;中心单元格有数字了,就从这个数字开始,一直运行到10000,或者撞到边界。

        起点和终点标绿,质数标红。

        由于水平有限,质数的判断算法比较低级,查了一些资料,看到筛选法效率应该是更高的了,省却了很多运算,不过10000之前其实还算是迅速的,几秒钟就能出结果,就不深究了。



Sub 生成质数螺旋()


    '定义计数器

    Dim i As Long

    Dim j As Long

    Dim x

    Dim y

    Dim n

    '初始化

    i = 1

    n = 0

    x = 0

    y = 0


    '判断当前是否为空

    If ActiveCell.Value = "" Then

        ActiveCell.Value = i

    Else

        i = ActiveCell.Value

    End If

    Selection.Interior.Color = RGB(0, 255, 0)


    '开始循环,最高算到10000,可以自己更改

    Do While i <= 10000

        i = i + 1

        '判断下一格的方向

        '初始化方向变量,12,3,6,9即上右下左(钟表方向)

        n12 = 0

        n3 = 0

        n6 = 0

        n9 = 0

        '提取当前单元格的坐标

        x = ActiveCell.Row

        y = ActiveCell.Column

        

        '判断当前单元格四周是否是空格,是就赋值,不是就保留0

        If Cells(x, y + 1).Value = "" Then n3 = 10

        If Cells(x + 1, y).Value = "" Then n6 = 100

        '因为判断上边和左边的格子时可能遇到边界,所以特殊处理

        If x = 1 Then

            n12 = 1

        ElseIf Cells(x - 1, y).Value = "" Then

            n12 = 1

        End If

        If y = 1 Then

            n9 = 1000

        ElseIf Cells(x, y - 1).Value = "" Then

            n9 = 1000

        End If

        '上右下左为空格时,方向变量分别被赋值为1,10,100,1000

        '把它们相加就可以得到一个唯一的数n来表示周边所有空格的情况

        n = n12 + n3 + n6 + n9


        '判断下一格坐标

        '当上右下为空格,或者上右为空格即n为11或111时

        '下一格在当前格的上面,即行号x-1

        If (n = 11 Or n = 111) Then x = x - 1

        '下一格在左

        If (n = 1001 Or n = 1011) Then y = y - 1

        '下一格在下

        If (n = 1101 Or n = 1100) Then x = x + 1

        '下一格在右,1111是在起始格时上下左右都是空

        If (n = 1110 Or n = 110 Or n = 1111) Then y = y + 1


        '判断是否到边界

        If (x = 0 Or y = 0) Then

            Selection.Interior.Color = RGB(0, 255, 0)

            MsgBox "到达边界!最大数为:" & i - 1

            Exit Do

        End If


        '写入数字

        Cells(x, y).Select

        ActiveCell.Value = i


        '判断是否质数

        For j = 2 To Int(Sqr(i)) + 1

            If i Mod j = 0 Then

                Exit For

            ElseIf j = Int(Sqr(i)) + 1 Then

                '是就填充颜色

                Selection.Interior.Color = RGB(255, 0, 0)

            End If

        Next

        

    '完成一个循环

    Loop

End Sub


附上一个模板:

http://pan.baidu.com/s/1slF6cKt

  
评论
——“本喵的萝莉很少”