如何用Excel VBA实现数字金字塔并设置隔单元格黑色填充？

一、修正金字塔生成逻辑 #

原代码仅填充了第一行和第一列的1，无法生成1、121、12321这类目标金字塔结构。正确的生成逻辑是：

• 第r行的数字序列为从1递增到r，再递减回1
• 每行起始列做居中处理，让整体呈现金字塔的对称效果

二、添加隔单元格填充黑色逻辑 #

通过判断单元格是否为空白（数字间隔位置），或者直接按位置奇偶性，来设置黑色填充。以下是两种实现思路的完整代码：

方案1：空白间隔单元格填充黑色（贴合示例样式） #

Option Explicit

Sub GeneratePyramid()
    Dim r As Integer, c As Integer
    Dim lengthr As Integer
    Dim startCol As Integer, currentNum As Integer
    
    ' 获取金字塔层数，添加输入合法性判断
    lengthr = InputBox("Insert length of pyramid")
    If lengthr < 1 Then Exit Sub
    
    ' 清空Sheet1原有内容与格式
    Worksheets("Sheet1").Cells.Clear
    
    For r = 1 To lengthr
        ' 计算当前行的起始列，实现金字塔居中
        startCol = lengthr - r + 1
        currentNum = 1
        
        ' 填充递增序列：1到r
        For c = startCol To startCol + r - 1
            Worksheets("Sheet1").Cells(r, c).Value = currentNum
            currentNum = currentNum + 1
        Next c
        
        ' 填充递减序列：r-1到1
        currentNum = r - 1
        For c = startCol + r To startCol + 2 * r - 2
            Worksheets("Sheet1").Cells(r, c).Value = currentNum
            currentNum = currentNum - 1
        Next c
        
        ' 将当前行的空白间隔单元格填充为黑色
        For c = 1 To lengthr * 2 - 1
            If Worksheets("Sheet1").Cells(r, c).Value = "" Then
                Worksheets("Sheet1").Cells(r, c).Interior.ColorIndex = 1 ' 黑色
            End If
        Next c
    Next r
    
    ' 统一调整列宽，优化显示效果
    Worksheets("Sheet1").Columns.ColumnWidth = 3
End Sub

方案2：按单元格位置奇偶性填充黑色 #

如果不需要区分数字单元格，仅按列的奇偶性批量填充，可替换颜色填充部分为以下代码：

' 示例：偶数列填充黑色
For c = 1 To lengthr * 2 - 1
    If c Mod 2 = 0 Then
        Worksheets("Sheet1").Cells(r, c).Interior.ColorIndex = 1
    End If
Next c

三、代码关键说明 #

1. 居中布局：通过startCol = lengthr - r + 1计算每行起始列，让金字塔整体对称居中
2. 数字序列生成：分两个循环分别生成递增、递减的数字，构建每行的12...r...21结构
3. 颜色填充：方案1精准识别空白间隔单元格涂黑，方案2按位置奇偶性快速批量设置
4. 优化处理：添加输入合法性判断、清空原有内容、调整列宽，提升代码健壮性和显示效果

内容的提问来源于stack exchange，提问作者Dema