1、写出公式很麻烦……我的大致思路是，利用行数列数构建二元函数表，把每个中间的空白格子都补上前面的数+0.5，这样中间一列很明显是二次函数y=0.5x^2+0.5（x是行数），左右依次减0.5加0.5就行了，然后这个三角左边和右边也都是二次函数（y=0.5x^2-0.5x+1, y=0.5x^2+0.5)，用这两个函数来判断什么时候显示空白
2、可以直接用offset

右边是y=0.5x^2+0.5x

今天写了一下，有let确实省事，少写一大堆东西

Option Explicit
Const NUM As Long = 5
Sub abc()
　Dim i, j, cnt, p, x, m, n, t
　For i = 1 To 5
　　cnt = cnt + i
　Next
　ReDim a(1 To NUM, 1 To 2 * NUM - 1)
　p = UBound(a, 2) \ 2 + 1: x = p
　For i = 1 To NUM
　　n = n + 1
　　For j = 1 To n
　　　m = m + 1
　　　a(i, x) = m
　　　x = x + 2
　　Next
　　p = p - 1: x = p
　Next
　Cells.Clear
　[a1].Resize(UBound(a), UBound(a, 2)) = a
　For i = 1 To NUM \ 2
　　For j = 1 To UBound(a, 2)
　　　t = a(i, j): a(i, j) = a(NUM - i + 1, j): a(NUM - i + 1, j) = t
　　Next
　Next
　[a1].Offset(, UBound(a, 2) + 1).Resize(UBound(a), UBound(a, 2)) = a
　Columns.AutoFit
End Sub

'估计又被吃掉了
Option Explicit
Const NUM As Long = 5
Sub abc()
　Dim i, j, cnt, p, x, m, n, t
　For i = 1 To 5
　　cnt = cnt + i
　Next
　ReDim a(1 To NUM, 1 To 2 * NUM - 1)
　p = UBound(a, 2) \ 2 + 1: x = p
　For i = 1 To NUM
　　n = n + 1
　　For j = 1 To n
　　　m = m + 1
　　　a(i, x) = m
　　　x = x + 2
　　Next
　　p = p - 1: x = p
　Next
　Cells.Clear
　[a1].Resize(UBound(a), UBound(a, 2)) = a
　For i = 1 To NUM \ 2
　　For j = 1 To UBound(a, 2)
　　　t = a(i, j): a(i, j) = a(NUM - i + 1, j): a(NUM - i + 1, j) = t
　　Next
　Next
　[a1].Offset(, UBound(a, 2) + 1).Resize(UBound(a), UBound(a, 2)) = a
　Columns.AutoFit
End Sub

B2单元格 =IF(AND(A1="",C1=""),"",MAX(1:1,$A2:A2)+1)
拉出足够大的范围。
在第一行合适的地方写个1,下面的三角就出来了。
放不下整行的地方，就不满足要求了。（如图的最后一行）