基于单元格值删除行并重命名工作表的VBA宏问题

需求说明 #

第一个工作表（Blad1）的A列有从1开始递增的编号列表，每个编号对应同名工作表（如编号1对应BT1）。现有宏可删除输入指定编号的对应行和工作表，但删除后需要完成两个操作：

• 更新A列的公式，让剩余列表重新从1开始连续递增
• 将剩余工作表按新的编号批量重命名（如删除BT3后，原BT4改为BT3，BT5改为BT4，以此类推）

修改后的完整宏代码 #

Sub Team_Verwijderen()
    Dim intMyVal As Integer
    Dim lngLastRow As Long, i As Long, deleteRow As Long
    Dim ws As Worksheet
    Dim newSheetName As String, currentNum As Integer
    
    ' 获取要删除的团队编号
    intMyVal = InputBox("请输入要删除的团队编号。")
    
    On Error GoTo Errorhandler
    
    ' 定位Blad1中对应编号的行
    lngLastRow = Blad1.Cells(Blad1.Rows.Count, "A").End(xlUp).Row
    deleteRow = 0
    For i = 3 To lngLastRow
        If Blad1.Cells(i, "A").Value = intMyVal Then
            deleteRow = i
            Exit For
        End If
    Next i
    
    ' 找到对应行后执行删除及后续操作
    If deleteRow > 0 Then
        ' 删除目标工作表
        Sheets("BT" & intMyVal).Delete
        
        ' 删除Blad1中对应行
        Blad1.Range("A" & deleteRow & ":K" & deleteRow).Delete xlUp
        
        ' 更新A列公式：从删除行的下一行开始，重新生成连续编号
        lngLastRow = Blad1.Cells(Blad1.Rows.Count, "A").End(xlUp).Row
        For i = deleteRow To lngLastRow
            Blad1.Cells(i, "A").Formula = "=IF(B" & i & "="""","""",A" & i - 1 & "+1)"
        Next i
        
        ' 批量重命名工作表：对编号大于被删编号的工作表，编号减1
        For Each ws In ThisWorkbook.Sheets
            If ws.Name Like "BT*" Then
                currentNum = Val(Mid(ws.Name, 3))
                If currentNum > intMyVal Then
                    newSheetName = "BT" & (currentNum - 1)
                    ws.Name = newSheetName
                End If
            End If
        Next ws
    End If
    
Errorhandler:
    Blad1.Select
    Blad1.Range("B3").Select
End Sub

关键修改说明 #

1. 精准定位删除行：替换原字符串拼接行号的逻辑，直接遍历找到对应编号的行，避免格式错误或多匹配问题
2. 批量更新列表公式：从删除行的下一行开始循环，逐个更新A列公式，确保编号连续递增
3. 工作表批量重命名：遍历所有工作表，筛选出BT开头的工作表，对编号大于被删编号的工作表执行编号减1重命名
4. 容错优化：增加判断逻辑，仅在找到有效目标行时执行后续操作，避免无效输入导致的报错

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