需求：编写VBA代码/公式生成符合单元格规则的序列号

VBA 代码实现 #

这个方案能精准匹配你的规则，直接运行即可批量生成序列号：

Sub GenerateSerialNumbers()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim startNum As Long
    Dim currentSerial As Long
    Dim prevAValue As String
    Dim i As Long
    
    ' 设置目标工作表，根据实际情况修改Sheet名称
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ' 获取数据最后一行
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    ' 初始序列号从H1+1开始
    startNum = ws.Range("H1").Value + 1
    currentSerial = startNum
    ' 记录上一行A列的值（假设数据从第2行开始）
    prevAValue = ws.Range("A2").Value
    
    ' 从第2行遍历到最后一行
    For i = 2 To lastRow
        ' 判断G列是否为"N"
        If UCase(ws.Range("G" & i).Value) = "N" Then
            ' 对比当前A列与上一行A列的值
            If ws.Range("A" & i).Value <> prevAValue Then
                ' A列内容变化，序列号递增
                currentSerial = currentSerial + 1
                ' 更新记录的A列值
                prevAValue = ws.Range("A" & i).Value
            End If
            ' 写入序列号
            ws.Range("H" & i).Value = currentSerial
        Else
            ' G列为"Y"，清空对应单元格
            ws.Range("H" & i).ClearContents
        End If
    Next i
End Sub

代码说明 #

• 先指定目标工作表，记得把Sheet1改成你实际的工作表名称
• 自动获取数据最后一行，无需手动指定范围
• 初始序列号取H1的值加1，完全匹配需求
• 遍历过程中：
  • 遇到G列是Y则清空对应H列单元格
  • G列是N时，检查当前A列值是否和上一行相同，相同则保持当前序列号，不同则递增后再写入

公式方案（适用于Excel 365/2021） #

如果不想用VBA，可尝试以下动态数组公式（Excel 365直接回车，旧版本按Ctrl+Shift+Enter）：

在H2单元格输入：

=IF(G2="Y","",LET(
    start, H1+1,
    aRange, A$2:A$1000, ' 替换为实际数据范围
    gRange, G$2:G$1000,
    groupId, SCAN("", aRange, LAMBDA(prev, curr, IF(INDEX(gRange,ROW(curr)-ROW(aRange)+1)="N",IF(curr=prev,prev,curr),prev))),
    serial, SCAN(start, groupId, LAMBDA(prev, curr, IF(curr<>prev,prev+1,prev))),
    INDEX(serial,ROW()-ROW(aRange)+1)
))

公式说明 #

• 用LET函数简化逻辑，先定义初始序列号、A列和G列范围
• SCAN函数标记出A列连续相同且G列为N的分组
• 第二个SCAN根据分组生成递增的序列号
• 最后用INDEX匹配当前行对应的序列号

注意：公式里的A$2:A$1000和G$2:G$1000需要替换成你实际的数据行范围。

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