【VBA】杨辉三角

Private Sub Workbook_Open()

Dim loopA As Integer
Dim loopB As Integer

Dim loopNum As Integer
Dim topCell As Range

loopNum = CInt(InputBox("input number", "title"))

Cells.Select
'Selection.ClearContents
Selection.Delete Shift:=xlUp

For loopA = 1 To loopNum

    If loopA = 1 Then
        Cells(loopA, loopNum).Value = "1"
        Cells(loopA, loopNum).Interior.Color = 255
        Set topCell = Cells(loopA, loopNum)
    GoTo nextFor
    
    Else
        For loopB = 1 To loopNum * 2 - 1
            Call setRangeValue(Cells(loopA, loopB))
            
            If loopA = loopNum Then
                If Len(Cells(loopA, loopB).Value) > 0 Then
                    Cells(loopA, loopB).Interior.Color = 255
                End If
            End If
        Next loopB
    End If
nextFor:

Next loopA

Cells.Select
'Cells.EntireColumn.AutoFit
Selection.ColumnWidth = 3
Cells.EntireRow.AutoFit
'Selection.RowHeight = 4

topCell.Activate
topCell.Select

End Sub

Public Sub setRangeValue(rag As Range)

Dim bfLeftRange As Range
Dim bfRightRange As Range
Dim leftVal As Double
Dim rightVal As Double

If rag.Column = 1 Then
    Set bfLeftRange = Cells(rag.Row - 1, rag.Column)
Else
    Set bfLeftRange = Cells(rag.Row - 1, rag.Column - 1)
End If

Set bfRightRange = Cells(rag.Row - 1, rag.Column + 1)

If Len(bfLeftRange.Value) = 0 And Len(bfRightRange.Value) = 0 Then
    rag.Value = ""
GoTo SubEnd
Else
    leftVal = CDbl(bfLeftRange.Value)
    rightVal = CDbl(bfRightRange.Value)
    rag.Value = leftVal + rightVal
    If rag.Value = "1" Then
        rag.Interior.Color = 255
    End If
    
End If

SubEnd:

End Sub