VBA宏需多次运行才能完成列删除及表头修改，如何实现单次运行完成

问题分析 #

1. DeleteSpecifcColumn宏：

   • 固定表头范围为Range("A1:N1")，删除列后该范围不会自动更新，导致部分目标列未被检测到
   • On Error Resume Next掩盖了潜在错误，比如列删除后xRg对象失效的问题
   • 数组存在重复元素（如textBox8多次出现），虽不影响功能但冗余

2. change_header_2宏：

   • 若先运行未修复的删除宏，列删除会导致表头位置偏移，需多次运行才能覆盖正确列；若单独运行仍需多次生效，大概率是工作表未激活或存在其他干扰（如保护、事件触发）

修正后的代码 #

1. 修复DeleteSpecifcColumn宏（一次删完所有目标列） #

Sub DeleteSpecifcColumn()
    Dim xFNum As Integer, xFFNum As Integer
    Dim xArrName As Variant
    Dim headerRng As Range, cell As Range
    Dim lastCol As Integer
    
    ' 获取当前表头的最后一列（动态适配列数变化）
    lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
    Set headerRng = Range(Cells(1, 1), Cells(1, lastCol))
    
    ' 目标表头文本数组（已去重）
    xArrName = Array("textBox25", "textBox4", "textBox6", "textBox8", "textBox19", _
                     "textBox9", "textBox10", "textBox11", "textBox22", "textBox12", _
                     "textBox23", "textBox5", "textBox7", "textBox24", "textBox1", _
                     "textBox3", "textBox14")
    
    ' 从后往前遍历表头，避免删除列导致的索引错位
    For xFFNum = headerRng.Count To 1 Step -1
        Set cell = headerRng.Cells(xFFNum)
        ' 检查当前单元格是否在目标数组中
        For xFNum = 0 To UBound(xArrName)
            If cell.Value = xArrName(xFNum) Then
                cell.EntireColumn.Delete
                Exit For ' 找到匹配项后跳出内层循环，避免重复删除
            End If
        Next xFNum
    Next xFFNum
End Sub

2. 修复change_header_2宏（确保一次生效） #

Sub change_header_2()
    ' 明确指定工作表，避免激活其他工作表导致失效
    With ThisWorkbook.ActiveSheet ' 或改为具体工作表名，如Sheets("Sheet1")
        .Cells(1, "A").Value = "Shift"
        .Cells(1, "B").Value = "Clock In Time"
        .Cells(1, "C").Value = "First Task"
        .Cells(1, "D").Value = "Last Task"
        .Cells(1, "E").Value = "Clock Out"
        .Cells(1, "F").Value = "User"
        .Cells(1, "G").Value = "Name"
    End With
End Sub

若仍需循环执行宏（备用方案） #

如果因特殊场景需要循环执行原宏，可编写以下调度宏：

Sub RunMacrosMultipleTimes()
    Dim runTimes As Integer
    Dim i As Integer
    
    runTimes = 3 ' 设置需要运行的次数
    For i = 1 To runTimes
        DeleteSpecifcColumn
        change_header_2
    Next i
End Sub

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