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
标签:运算,Set,20,Wb,End,加法,Const,posture From: https://www.cnblogs.com/nextseven/p/16771010.html