Excel VBA实现单元格值按重复次数递增写入并支持999回滚

核心逻辑实现步骤 #

• 拆分源工作表sourceSheet的N19单元格编号为前缀字母和数字部分（例如将"C251"拆为"C"和251）
• 根据ComboBox选择的重复次数，循环生成递增后的编号
• 特殊规则处理：当当前编号为"D999"且剩余生成次数≥1时，下一个编号直接重置为"D1"，继续递增
• 定位目标工作簿dados.xlsm中Dados工作表L列的最后非空行，从下一行开始依次写入生成的编号

完整可运行VBA代码 #

Sub WriteIncrementedNumbers()
    Dim sourceWs As Worksheet
    Dim targetWb As Workbook
    Dim targetWs As Worksheet
    Dim startNum As String
    Dim prefix As String
    Dim num As Long
    Dim repeatCount As Integer
    Dim lastRow As Long
    Dim i As Integer
    
    ' 绑定源工作表
    Set sourceWs = ThisWorkbook.Sheets("sourceSheet")
    
    ' 检查目标工作簿是否打开
    On Error Resume Next
    Set targetWb = Workbooks("dados.xlsm")
    On Error GoTo 0
    If targetWb Is Nothing Then
        MsgBox "请先打开目标工作簿dados.xlsm！", vbExclamation
        Exit Sub
    End If
    Set targetWs = targetWb.Sheets("Dados")
    
    ' 获取起始编号和重复次数
    startNum = sourceWs.Range("N19").Value
    repeatCount = ComboBox1.Value ' 替换为你的ComboBox控件实际名称
    
    ' 拆分前缀与数字（默认前缀为单个字母，数字为3位，可按需调整）
    prefix = Left(startNum, 1)
    num = CLng(Mid(startNum, 2))
    
    ' 定位L列最后非空行，从下一行开始写入
    lastRow = targetWs.Cells(targetWs.Rows.Count, "L").End(xlUp).Row + 1
    
    ' 循环生成并写入编号
    For i = 1 To repeatCount
        ' 写入当前编号，保持3位数字格式
        targetWs.Cells(lastRow + i - 1, "L").Value = prefix & Format(num, "000")
        
        ' 处理D999的特殊递增规则
        If prefix = "D" And num = 999 And i < repeatCount Then
            num = 1 ' 重置为D1
        Else
            num = num + 1 ' 正常递增
        End If
    Next i
    
    MsgBox "编号已成功写入！", vbInformation
End Sub

关键部分说明 #

1. 编号拆分适配：如果你的编号前缀是多个字母、数字位数不是3位，可调整Left和Mid的参数（例如前缀2位则用Left(startNum,2)）
2. D999逻辑判断：通过i < repeatCount确保只有在还需要生成后续编号时才触发重置，避免最后一次生成D999后多余重置
3. 数据安全写入：用End(xlUp)定位最后一行，完全避免覆盖目标列已有数据
4. 格式一致性：Format(num, "000")确保数字始终以3位格式显示（比如1显示为001），和源单元格格式匹配

内容的提问来源于stack exchange，提问作者Gonçalo