VBA批量处理Excel工作簿：删除code_D_工作表后补全code_n_系列序号断档

你原有代码中逐个判断code_D_*工作表的写法适配性差，优化为通用逻辑同时追加序号补全功能即可，修改后的完整代码如下：

Sub AllFiles()
    Dim folderPath As String
    Dim filename As String
    Dim wb As Workbook
    
    ' 此处修改为你的目标文件夹路径
    folderPath = "C:\Users\user\OneDrive\Desktop\something\macro_test\"
    
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"
    
    filename = Dir(folderPath & "*.xls*") ' 兼容xls、xlsx、xlsm等格式
    Application.ScreenUpdating = False
    Do While filename <> ""
        Set wb = Workbooks.Open(folderPath & filename)
         
        ' 调用处理单工作簿的子程序
        Call Mymacro(wb)
        
        wb.Save
        wb.Close
        filename = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

Sub Mymacro(wb As Workbook)
    Dim ws As Worksheet
    Dim wsList As Object
    Dim i As Long, oldNum As Long
    Dim namePrefix As String
    
    Set wsList = CreateObject("System.Collections.ArrayList")
    Application.DisplayAlerts = False
    
    ' 第一步：删除所有code_D_前缀的工作表
    For Each ws In wb.Worksheets
        If Left(ws.Name, 7) = "code_D_" Then
            ws.Delete
        ' 同时收集所有code_n_前缀的工作表序号
        ElseIf Left(ws.Name, 7) = "code_n_" Then
            If IsNumeric(Mid(ws.Name, 8)) Then
                oldNum = CLng(Mid(ws.Name, 8))
                wsList.Add oldNum
            End If
        End If
    Next ws
    
    ' 第二步：将收集到的序号升序排序
    wsList.Sort
    
    ' 第三步：按排序后的顺序依次重命名为连续序号
    namePrefix = "code_n_"
    For i = 0 To wsList.Count - 1
        wb.Worksheets(namePrefix & wsList(i)).Name = namePrefix & (i + 1)
    Next i
    
    Application.DisplayAlerts = True
End Sub

• 适配任意数量的code_D_*和code_n_*工作表，无需手动指定最大序号
• 自动识别code_n_前缀的工作表序号，排序后统一重命名为从1开始的连续序号，自动消除所有断档
• 处理完成后自动保存并关闭工作簿，无需手动操作

如果删除code_D_*工作表后剩余的code_n_工作表序号为1,2,3,5,6,8，处理后会自动重命名为1,2,3,4,5,6

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