1、第一种方法【测试管用】

Sub DeleteColumnsBasedOnArray()
    Dim arrValues() As Variant
    Dim rng As Range
    Dim cell As Range
    Dim i As Long
    Application.ScreenUpdating = False
    
    ' 指定数组
    arrValues = Array("交易电量（kwh）", "充电桩编号", "充电开始时间", "充电结束时间", "VIN码", "卡号", "交易结束原因")
    
    ' 设置要检查的范围
    Set rng = ThisWorkbook.Sheets("Sheet1").Rows(1).Cells
    'Set rng =ThisWorkbook.Sheets("Sheet1").Range("A1:BN1")
    
    ' 从右向左遍历列，避免因删除列导致的列索引变化问题
    For i = rng.Columns.Count To 1 Step -1
        ' 检查当前列的值是否在数组中
        If Not IsValueInArray(rng.Columns(i).Value, arrValues) Then
            ' 如果不在数组中，删除该列
            Columns(i).Delete
        End If
    Next i
    
    Application.ScreenUpdating = True
End Sub
 
' 检查值是否在数组中
Function IsValueInArray(valToBeFound As Variant, arr As Variant) As Boolean
    Dim i As Long
    IsValueInArray = False
    For i = LBound(arr) To UBound(arr)
        If arr(i) = valToBeFound Then
            IsValueInArray = True
            Exit For
        End If
    Next i
End Function

2、第二种【测试，不能一次性删除，要点多几次才行】：

Sub DeleteColumnsNotInArray()
    Dim MyArray As Variant
    Dim MyRange As Range
    Dim MyCell As Range
    
    
    '将给定数组分配给变量
    MyArray = Array("交易电量（kwh）", "充电桩编号", "充电开始时间", "充电结束时间", "VIN码", "卡号", "交易结束原因")
    
    '定义要搜索的单元格范围
    'Set MyRange = ActiveSheet.Range("A1:BN1")
    Set MyRange = ThisWorkbook.Sheets(1).Range("A1:BN1")
    
    Application.ScreenUpdating = False
    
    '循环遍历范围中的单元格
    For Each MyCell In MyRange
        
        '检查当前单元格的值是否在数组中
        If IsError(Application.Match(MyCell.value, MyArray, 0)) _
            And MyCell.EntireColumn.Hidden = False Then
            
            '如果不在数组中，并且列未隐藏，则删除该列
            MyCell.EntireColumn.Delete            
        End If        
    Next MyCell
    
    Application.ScreenUpdating = True
End Sub

此代码可以根据需要进行修改。要使用它，请将给定数组的值更改为您的值，以及要搜索的单元格范围。如果您想检查隐藏的列，请删除And MyCell.EntireColumn.Hidden = False这行代码。

第三种【测试OK】:

Sub DeleteNonSpecifiedColumns()
    Dim ws As Worksheet
    Dim keepColumns As Variant
    Dim i As Long
    Dim colIndex As Variant
    Dim lastCol As Long
    
    ' 设置工作表
    Set ws = ThisWorkbook.Worksheets("Sheet1") ' 修改为你的工作表名称
    
    ' 定义需要保留的列数组
    keepColumns = Array("交易电量（kwh）", "充电桩编号", "充电开始时间", "充电结束时间", "VIN码", "卡号", "交易结束原因")
    
    ' 找到最后一列的索引
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    
    ' 循环检查每一列
    Application.ScreenUpdating = False
    For i = lastCol To 1 Step -1
        ' 如果是第一行
        If ws.Cells(1, i).Row = 1 Then
            ' 检查是否在保留列数组中
            colIndex = Application.Match(ws.Cells(1, i).Value, keepColumns, 0)
            If IsError(colIndex) Then
                ' 如果不在数组中，则删除该列
                ws.Columns(i).Delete
            End If
        End If
    Next i
    Application.ScreenUpdating = True
End Sub