VBA代码求助：指定数组列变色正常，其余列未按要求变红

直接用遍历判断列名是否在目标数组的方式就能解决，不用额外建第二个数组。下面是修改后的完整代码，附带关键说明：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim typeCol As Long
    Dim targetRow As Long
    Dim targetCols As Variant
    Dim currentCol As Long
    Dim lastCol As Long
    Dim colName As String
    Dim isInArray As Boolean
    
    ' 关闭事件避免循环触发
    Application.EnableEvents = False
    
    On Error GoTo ErrorHandler ' 确保出错后能恢复事件
    
    ' 替换成你原来指定的、要设浅蓝的列名数组
    targetCols = Array("列名1", "列名2", "列名3")
    
    ' 找到Type列的位置（假设表头在第1行，按需调整）
    typeCol = Me.Rows(1).Find(What:="Type", LookIn:=xlValues, LookAt:=xlWhole).Column
    
    ' 只处理Type列单元格变化的情况
    If Not Intersect(Target, Me.Columns(typeCol)) Is Nothing Then
        targetRow = Target.Row
        
        ' 获取工作表最后一列，减少无效遍历
        lastCol = Me.Cells(1, Me.Columns.Count).End(xlToLeft).Column
        
        ' 遍历当前行的所有列
        For currentCol = 1 To lastCol
            colName = Me.Cells(1, currentCol).Value
            isInArray = False
            
            ' 检查当前列名是否在目标数组里
            For Each item In targetCols
                If item = colName Then
                    isInArray = True
                    Exit For
                End If
            Next item
            
            ' 按判断结果设置单元格底色
            If isInArray Then
                Me.Cells(targetRow, currentCol).Interior.Color = RGB(192, 222, 230)
            Else
                Me.Cells(targetRow, currentCol).Interior.Color = RGB(255, 0, 0)
            End If
        Next currentCol
    End If
    
ErrorHandler:
    ' 恢复事件，避免后续操作失效
    Application.EnableEvents = True
    If Err.Number <> 0 Then
        MsgBox "错误：" & Err.Description, vbExclamation
    End If
End Sub

关键说明 #

1. 无需第二数组：通过内层循环检查列名是否在你原有的目标数组中，直接区分两种格式逻辑
2. 效率优化：获取最后一列的位置，只遍历有表头的列，避免空列无效操作
3. 事件保护：加入Application.EnableEvents = False防止循环触发Change事件，错误处理确保事件能恢复
4. 灵活调整：如果表头不在第1行，把Rows(1)改成实际表头行号即可

内容的提问来源于stack exchange，提问作者D.V.