Excel VBA中在现有列间插入新列的代码故障排查

问题背景 #

需求为在Excel现有两列之间插入新列（例如原有A、B、C列，需在B与C之间插入新列，最终列顺序为A、B、[新列]、原C列（变为D列）），但使用Columns(targetColumn).Insert Shift:=xlToRight方法时，代码未插入新列，反而覆盖了现有列，所用代码如下：

Public Sub LastColumn()
    Dim hLink As Hyperlink
    Dim targetColumn As Long
    
    targetColumn = InputBox("Enter the number of the column to which you want to add the new column:", "Add new column")
    
    ThisWorkbook.Sheets("Holiday plans 2023_Team").Activate
    With ThisWorkbook.Sheets("Holiday plans 2023_Team")
        Dim LastCol As Long
        LastCol = targetColumn - 1
        Columns(targetColumn).Insert Shift:=xlToRight
        Columns(LastCol).Copy Destination:=Cells(1, targetColumn)
        Cells(15, targetColumn).Value = ActiveWorkbook.Worksheets(Sheets("BLANK1").Index - 1).Name
        With .Columns(targetColumn)
            .Replace What:=Cells(15, targetColumn - 1).Value, Replacement:=Cells(15, targetColumn).Value, LookAt:=xlPart, _
                     SearchOrder:=xlByRows, MatchCase:=False, _
                     SearchFormat:=False, ReplaceFormat:=False
        End With
    End With
    
    ThisWorkbook.Sheets("Holiday plans 2023_Manager").Activate
    With ThisWorkbook.Sheets("Holiday plans 2023_Manager")
        LastCol = targetColumn - 1
        
        Columns(LastCol).Copy Destination:=Cells(1, targetColumn)
        Cells(15, targetColumn).Value = ActiveWorkbook.Worksheets(Sheets("BLANK1").Index - 1).Name
        With .Columns(targetColumn)
            .Replace What:=Cells(15, targetColumn - 1).Value, Replacement:=Cells(15, targetColumn).Value, LookAt:=xlPart, _
                     SearchOrder:=xlByRows, MatchCase:=False, _
                     SearchFormat:=False, ReplaceFormat:=False
            .Replace What:="!D", Replacement:="!C", LookAt:=xlPart, _
                     SearchOrder:=xlByRows, MatchCase:=False, _
                     SearchFormat:=False, ReplaceFormat:=False
        End With
    End With
End Sub

原因分析 #

1. Manager工作表未执行插入列操作 #

代码仅在Holiday plans 2023_Team工作表中调用了Columns(targetColumn).Insert Shift:=xlToRight完成插入列的动作，但在处理Holiday plans 2023_Manager工作表时，完全跳过了插入列的步骤，直接将内容复制到targetColumn对应的列，这必然会覆盖该列原有内容，导致“未插入新列反而覆盖”的现象。

2. 未限定工作表的单元格引用导致逻辑歧义 #

在With块中（例如With ThisWorkbook.Sheets("Holiday plans 2023_Team")），部分单元格引用未添加.前缀（如Cells(1, targetColumn)、Cells(15, targetColumn - 1)），这会导致代码引用当前激活的工作表而非With块指定的工作表，容易引发逻辑混乱，比如在处理Manager工作表时，可能错误引用Team工作表的单元格值，间接导致覆盖问题。

3. 输入参数的逻辑匹配问题 #

若用户输入的targetColumn值不符合插入逻辑（比如需求是在B(2)和C(3)之间插入，需输入3以插入到C列位置，让原C列右移；若输入2则会插入到B列位置），会导致插入位置不符合预期，但这属于输入逻辑的问题，并非代码不执行插入的直接原因。

修正后的代码示例 #

Public Sub LastColumn()
    Dim targetColumn As Long
    Dim wsTeam As Worksheet, wsManager As Worksheet
    Dim wsName As String
    
    ' 获取输入列号并做合法性校验
    targetColumn = InputBox("Enter the number of the column to which you want to add the new column:", "Add new column")
    If targetColumn < 1 Then Exit Sub
    
    ' 提前获取目标工作表名称，避免重复计算
    wsName = ThisWorkbook.Worksheets(Sheets("BLANK1").Index - 1).Name
    
    ' 处理Team工作表
    Set wsTeam = ThisWorkbook.Sheets("Holiday plans 2023_Team")
    With wsTeam
        .Columns(targetColumn).Insert Shift:=xlToRight
        .Columns(targetColumn - 1).Copy Destination:=.Cells(1, targetColumn)
        .Cells(15, targetColumn).Value = wsName
        .Columns(targetColumn).Replace What:=.Cells(15, targetColumn - 1).Value, _
                                      Replacement:=wsName, _
                                      LookAt:=xlPart, MatchCase:=False
    End With
    
    ' 处理Manager工作表（新增插入列步骤，修正单元格引用）
    Set wsManager = ThisWorkbook.Sheets("Holiday plans 2023_Manager")
    With wsManager
        .Columns(targetColumn).Insert Shift:=xlToRight
        .Columns(targetColumn - 1).Copy Destination:=.Cells(1, targetColumn)
        .Cells(15, targetColumn).Value = wsName
        .Columns(targetColumn).Replace What:=.Cells(15, targetColumn - 1).Value, _
                                      Replacement:=wsName, _
                                      LookAt:=xlPart, MatchCase:=False
        .Columns(targetColumn).Replace What:="!D", Replacement:="!C", _
                                      LookAt:=xlPart, MatchCase:=False
    End With
    
    ' 释放对象变量
    Set wsTeam = Nothing
    Set wsManager = Nothing
End Sub

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