如何使用数组查找Excel列并将匹配到的列移动到其他工作表

原来的代码报错的核心原因是：当Find方法找不到指定的列标题时，会返回Nothing空对象，此时直接调用.Column属性就会触发VBA运行时错误。

以下是优化后的可直接运行的代码：

Option Explicit

Sub MoveCol2()
    Dim ar As Variant
    Dim i As Integer
    Dim foundRng As Range
    Dim targetCol As Integer
    
    ' 按需求定义列标题数组
    ar = Array("Sales", "Dept 1", "Dept 8", "Dept 9")
    ' 可选：清空目标Sheet2的旧数据，不需要可删除
    Sheet2.Cells.Clear
    ' 目标表写入列的初始位置
    targetCol = 1
    
    For i = 0 To UBound(ar)
        ' 显式指定查找范围和匹配规则，避免全局查找设置影响结果
        Set foundRng = Sheet1.Range("A1:S1").Find(What:=ar(i), LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        
        ' 仅当找到对应列时执行复制
        If Not foundRng Is Nothing Then
            Columns(foundRng.Column).Copy Sheet2.Cells(1, targetCol)
            targetCol = targetCol + 1 ' 匹配成功才偏移目标列，避免缺失列产生空列
        End If
    Next i
End Sub

代码优化说明 #

• 新增foundRng变量接收查找结果，先判断匹配结果是否存在再做后续操作，从根源上避免找不到列时的报错
• 显式指定Find的核心匹配参数：LookAt:=xlWhole保证完全匹配列标题，不会出现短标题模糊匹配长标题的问题，MatchCase:=False设置忽略大小写匹配，可根据自身需求调整参数
• 新增targetCol变量保证目标表的列是连续的，不会因为原数组有缺失列产生空白列。如果你需要保留原数组的列位置、缺失列的对应位置留空，只需要把复制行的targetCol替换为i + 1，删除targetCol相关的定义和赋值代码即可。

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