20内加法运算式

Sub newPages()
    Application.DisplayAlerts = False
    Dim Wb As Workbook
    Dim NewSht As Worksheet
    Dim i
    Set Wb = Application.ThisWorkbook
    For i = 1 To 200
        Set NewSht = Wb.Worksheets.Add(After:=Wb.Worksheets(Wb.Worksheets.Count))
        On Error Resume Next
        Wb.Worksheets(CStr(i)).Delete
        On Error GoTo 0
        NewSht.Name = i
        NewSht.Activate
        Call NewPosture20
    Next i
    Application.DisplayAlerts = True
    Set Wb = Nothing
    Set NewSht = Nothing
End Sub
'创建20以内的加法式子
Sub NewPosture20()
    Const SUM_N = 20 '和不超过20
    Const P_COUNT = 60 '产生多少道题
    Const COLUMN_N = 4 '分几列输出
    Const GAP_N = 1 '间隔
    Const HEADER_N = 2 '表头预留行数
    Dim d As Object, a, b, posture, n, r, c
    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To 20000
        a = Int(WorksheetFunction.RandBetween(1, SUM_N - 0.01))
        b = Int(WorksheetFunction.RandBetween(1, SUM_N + 0.99 - a))
        posture = a & " + " & b & " ="
        'Debug.Print posture
        If Not d.exists(posture) Then
            d(posture) = ""
        Else
            posture = b & " + " & a & " ="
            '支持前后
            If Not d.exists(posture) Then d(posture) = ""
        End If
        If d.Count = P_COUNT Then Exit For
    Next i
    'Debug.Print d.Count
    With ActiveSheet
        '.Cells.Clear
        .Range("A1").Value = SUM_N & "以内加法"
        .Range("A1").Resize(1, COLUMN_N * 2).Merge
        n = 0
        For Each posture In d.keys
            'Debug.Print posture
            n = n + 1
            r = Int((n - 1) / COLUMN_N + 1)
            c = Int((n - 1) Mod COLUMN_N + 1)
            'Debug.Print r, c
            Cells((r - 1) * (GAP_N + 1) + 1 + HEADER_N, (c - 1) * (GAP_N + 1) + 1).Value = posture
        Next
        With .UsedRange.SpecialCells(xlCellTypeConstants, 23)
            .Font.Size = 14
            .Font.Bold = True
            .Font.Name = "微软雅黑"
            .Columns.AutoFit
            .HorizontalAlignment = xlCenter
        End With
    End With
    Set d = Nothing
End Sub