1 Private Sub Workbook_Open() 2 3 Dim loopA As Integer 4 Dim loopB As Integer 5 6 Dim loopNum As Integer 7 Dim topCell As Range 8 9 loopNum = CInt(InputBox("input number", "title")) 10 11 Cells.Select 12 'Selection.ClearContents 13 Selection.Delete Shift:=xlUp 14 15 For loopA = 1 To loopNum 16 17 If loopA = 1 Then 18 Cells(loopA, loopNum).Value = "1" 19 Cells(loopA, loopNum).Interior.Color = 255 20 Set topCell = Cells(loopA, loopNum) 21 GoTo nextFor 22 23 Else 24 For loopB = 1 To loopNum * 2 - 1 25 Call setRangeValue(Cells(loopA, loopB)) 26 27 If loopA = loopNum Then 28 If Len(Cells(loopA, loopB).Value) > 0 Then 29 Cells(loopA, loopB).Interior.Color = 255 30 End If 31 End If 32 Next loopB 33 End If 34 nextFor: 35 36 Next loopA 37 38 Cells.Select 39 'Cells.EntireColumn.AutoFit 40 Selection.ColumnWidth = 3 41 Cells.EntireRow.AutoFit 42 'Selection.RowHeight = 4 43 44 topCell.Activate 45 topCell.Select 46 47 End Sub 48 49 Public Sub setRangeValue(rag As Range) 50 51 Dim bfLeftRange As Range 52 Dim bfRightRange As Range 53 Dim leftVal As Double 54 Dim rightVal As Double 55 56 If rag.Column = 1 Then 57 Set bfLeftRange = Cells(rag.Row - 1, rag.Column) 58 Else 59 Set bfLeftRange = Cells(rag.Row - 1, rag.Column - 1) 60 End If 61 62 Set bfRightRange = Cells(rag.Row - 1, rag.Column + 1) 63 64 If Len(bfLeftRange.Value) = 0 And Len(bfRightRange.Value) = 0 Then 65 rag.Value = "" 66 GoTo SubEnd 67 Else 68 leftVal = CDbl(bfLeftRange.Value) 69 rightVal = CDbl(bfRightRange.Value) 70 rag.Value = leftVal + rightVal 71 If rag.Value = "1" Then 72 rag.Interior.Color = 255 73 End If 74 75 End If 76 77 SubEnd: 78 79 End Sub