VBA工作表列重排异常：代码运行后新表无数据输出求助

需要参照「Good Columns」工作表的列顺序，重排「Bad Columns」的表头和数据列（例如将a,c,d,b调整为a,b,c,d），结果存入新建的「Fixed」工作表。现有代码能运行但「Fixed」无数据输出，同时要处理不同数据集的列长度差异，多余表头需放在末尾。

原有代码的问题点 #

第一段代码错误 #

1. With bws块内的Range(Cells(1,1),...)未指定父对象，默认使用活动工作表，导致表头查找范围错误
2. 复制目标位置错误：Sheets("Fixed").Cells(1, bcols)会把所有列都复制到同一列（「Bad Columns」的最后一列），覆盖后无法看到有效数据
3. 未处理「Bad Columns」中多余表头的需求

第二段代码错误 #

1. 工作表命名逻辑错误：Sheets(i).Name = "Fixed"会把原「Bad Columns」改名为「Fixed」，而非给新建工作表命名
2. 同样存在Range(Cells(1,1),...)未指定父对象的问题
3. 未处理多余表头的需求

修正后的完整代码 #

Option Explicit

Sub FixColumnOrder()
    Dim wsGood As Worksheet, wsBad As Worksheet, wsFixed As Worksheet
    Dim header As String
    Dim colCountGood As Long, colCountBad As Long
    Dim foundCol As Range
    Dim targetCol As Long
    Dim i As Long
    Dim isHeaderMatched As Boolean
    
    ' 绑定目标工作表对象
    Set wsGood = ThisWorkbook.Worksheets("Good Columns")
    Set wsBad = ThisWorkbook.Worksheets("Bad Columns")
    
    ' 创建并命名新的结果工作表
    Set wsFixed = ThisWorkbook.Sheets.Add(Before:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    wsFixed.Name = "Fixed"
    
    ' 获取两个工作表的表头列数（兼容不同Excel版本）
    colCountGood = wsGood.Cells(1, wsGood.Columns.Count).End(xlToLeft).Column
    colCountBad = wsBad.Cells(1, wsBad.Columns.Count).End(xlToLeft).Column
    
    targetCol = 1
    
    ' 第一步：按Good Columns的顺序复制匹配的列
    For i = 1 To colCountGood
        header = wsGood.Cells(1, i).Value
        ' 明确指定父工作表，避免活动表干扰查找
        Set foundCol = wsBad.Range(wsBad.Cells(1, 1), wsBad.Cells(1, colCountBad)).Find( _
            What:=header, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        
        If Not foundCol Is Nothing Then
            wsBad.Columns(foundCol.Column).Copy Destination:=wsFixed.Columns(targetCol)
            targetCol = targetCol + 1
        End If
    Next i
    
    ' 第二步：复制Bad Columns中多余的表头（Good里没有的）到末尾
    For i = 1 To colCountBad
        header = wsBad.Cells(1, i).Value
        isHeaderMatched = False
        
        ' 检查当前表头是否在Good Columns中存在
        Set foundCol = wsGood.Range(wsGood.Cells(1, 1), wsGood.Cells(1, colCountGood)).Find( _
            What:=header, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        
        If foundCol Is Nothing Then
            ' 不存在则复制到Fixed的末尾
            wsBad.Columns(i).Copy Destination:=wsFixed.Columns(targetCol)
            targetCol = targetCol + 1
        End If
    Next i
End Sub

关键修正说明 #

• 明确工作表对象：所有单元格/范围操作都指定父工作表，彻底避免活动工作表的干扰
• 修正复制目标位置：用targetCol逐步递增，确保列按顺序排列，不会覆盖
• 处理多余表头：新增循环，将「Bad Columns」中不存在于「Good Columns」的表头列复制到「Fixed」末尾
• 兼容Excel版本：用Columns.Count替代固定列名（如IV、MD），适配新旧Excel版本的列数上限
• 正确创建结果表：直接给新建的wsFixed命名，不会修改原有工作表名称

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