如何用VBA按工作表名称中的数字排序指定前缀的工作表？

方案一：创建时直接插入正确位置（推荐） #

直接在生成新工作表的环节调整插入位置，避免后续排序的麻烦。核心逻辑是：

• 获取新工作表的编号（比如B-item-2的编号是2）
• 在B工作表之后、C工作表之前，找到第一个编号大于当前编号的B-item-*工作表，将新表插入到它前面；如果没有更大编号的，就插入到C工作表之前。

示例代码：

Sub CreateAndInsertBItemSheet()
    Dim templateSheet As Worksheet
    Dim newSheet As Worksheet
    Dim targetNum As Integer
    Dim ws As Worksheet
    Dim insertPos As Worksheet
    
    ' 假设用户输入的编号存在变量targetNum里，这里示例设为2
    targetNum = 2
    Set templateSheet = ThisWorkbook.Worksheets("模板") ' 替换为你的模板表名
    
    ' 复制模板生成新表
    templateSheet.Copy After:=ThisWorkbook.Worksheets("B")
    Set newSheet = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
    newSheet.Name = "B-item-" & targetNum
    
    ' 寻找正确的插入位置
    Set insertPos = ThisWorkbook.Worksheets("C") ' 默认插在C前面
    For Each ws In ThisWorkbook.Worksheets
        ' 只遍历B之后、C之前的工作表
        If ws.Index > ThisWorkbook.Worksheets("B").Index And ws.Index < ThisWorkbook.Worksheets("C").Index Then
            ' 判断是否是B-item-开头的表
            If Left(ws.Name, 7) = "B-item-" Then
                ' 提取编号
                Dim currentNum As Integer
                currentNum = Val(Mid(ws.Name, 8))
                ' 找到第一个编号大于targetNum的表，插在它前面
                If currentNum > targetNum Then
                    Set insertPos = ws
                    Exit For
                End If
            End If
        End If
    Next ws
    
    ' 移动新表到目标位置
    newSheet.Move Before:=insertPos
End Sub

方案二：事后批量重排已混乱的工作表 #

如果已经有混乱的工作表，按你的思路实现排序：

1. 筛选出B之后、C之前的所有B-item-*工作表，记录它们的名称和编号
2. 按编号从小到大排序
3. 依次将这些工作表移动到B之后、前一个排序好的工作表之后

示例代码：

Sub SortBItemSheets()
    Dim wsList As Collection
    Dim ws As Worksheet
    Dim i As Integer, j As Integer
    Dim tempWs As Worksheet
    Dim currentNum As Integer, compareNum As Integer
    
    Set wsList = New Collection
    
    ' 步骤1：收集需要排序的工作表（B之后、C之前的B-item-*）
    For Each ws In ThisWorkbook.Worksheets
        If ws.Index > ThisWorkbook.Worksheets("B").Index And ws.Index < ThisWorkbook.Worksheets("C").Index Then
            If Left(ws.Name, 7) = "B-item-" Then
                wsList.Add ws
            End If
        End If
    Next ws
    
    ' 步骤2：双层循环按编号排序（冒泡排序）
    For i = 1 To wsList.Count - 1
        For j = i + 1 To wsList.Count
            currentNum = Val(Mid(wsList(i).Name, 8))
            compareNum = Val(Mid(wsList(j).Name, 8))
            If currentNum > compareNum Then
                ' 交换集合中的顺序
                Set tempWs = wsList(i)
                wsList.Remove i
                wsList.Add tempWs, Before:=j
            End If
        Next j
    Next i
    
    ' 步骤3：按排序后的顺序移动工作表
    Set tempWs = ThisWorkbook.Worksheets("B")
    For Each ws In wsList
        ws.Move After:=tempWs
        Set tempWs = ws
    Next ws
End Sub

代码说明 #

• 两个方案都依赖B和C工作表的存在，确保它们的名称固定
• 提取编号时用Val(Mid(ws.Name, 8))，因为"B-item-"是7个字符，从第8位开始提取数字部分
• 冒泡排序适合工作表数量不多的场景，如果表数量很大，可以改用更高效的排序算法

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