VBA代码修改后出现Array Expected错误排查求助

算力阿峰

2026-7-1

问题描述

我正在开展一个合并多工作表的项目，各工作表列数不同，部分列名也存在差异。此前获取的VBA代码可将所需3个工作表保存为CSV文件，便于手动导入SQL。为实现直接导入SQL的目标，我修改代码改为保留指定3个工作表而非保存CSV，起初在未修改的If cbSht Is Nothing Then行出现Object Required错误，经规范变量定义修复后，又在未修改的For j = LBound(arrData, 2) To UBound(arrData, 2)行出现Array Expected错误。

正常运行的代码

Option Explicit

Sub Demo()
    Dim i As Long, j As Long
    Dim vKey, oDic, arrData, rngData, cell As Range
    Dim arrRes, iR As Long, iC As Long, iRes As Long
    Dim LastRow As Long, LastCol As Long, ColCnt As Long
    Dim oSht As Worksheet, cbSht As Worksheet, ws As Worksheet
    Const CB_SHT = "CombinedData"
    
    'remove unneeded sheets
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Sheets(Array("About", "Overview_Total", "Overview_Casino", "Overview_Sports", "Overview_iGaming", "Statewide")).Delete

    'Fix the RI opened data
    Sheets("RI").Columns("C:C").Replace What:="1993", Replacement:=""
    
    'All Caps headers
    For Each oSht In ThisWorkbook.Sheets
        oSht.Activate
        With Rows(1)
        .Value = Evaluate("SUBSTITUTE(SUBSTITUTE(TRIM(INDEX(UPPER(" & .Address(External:=True) & "),)), "","", "|" )," " ,"_")")
        End With
    Next oSht
    
    'Move Distributed and Sports betting to new workbooks
    Sheets("Distributed").Columns("F:J").NumberFormat = "0.00"
    Sheets("Distributed").Columns("K:Z").Delete

    ThisWorkbook.Sheets("Distributed").Copy
    ActiveWorkbook.SaveAs Filename:="\\filepath\Distributed.csv", FileFormat:=xlCSV, CreateBackup:=True
    ActiveWorkbook.Close
  
    Sheets("Distributed").Delete
    
    Sheets("Betting by Sport").Columns("E:AJ").NumberFormat = "0.00"
    ThisWorkbook.Sheets("Betting by Sport").Copy
    ActiveWorkbook.SaveAs Filename:="\\filepath\Sports_betting.csv", FileFormat:=xlCSV, CreateBackup:=True
    ActiveWorkbook.Close
  
    Sheets("Betting by Sport").Delete
    
    ' Create CombinedData sheet
    On Error Resume Next
    Set cbSht = Sheets(CB_SHT)
    On Error GoTo 0
    If cbSht Is Nothing Then
        Set cbSht = Sheets.Add
        cbSht.Name = CB_SHT
    Else
        cbSht.Cells.Clear
    End If
    Set oDic = CreateObject("scripting.dictionary")
    iR = 2
    
    ' loop through worksheet
    For Each oSht In Worksheets
        If oSht.Name <> CB_SHT Then
            LastRow = oSht.Cells(oSht.Rows.Count, "A").End(xlUp).Row
            If LastRow > 1 Then
                LastCol = oSht.Cells(1, oSht.Columns.Count).End(xlToLeft).Column
                Set rngData = oSht.Range("A1", oSht.Cells(LastRow, LastCol))
                arrData = rngData.Value ' load data into an array
                For j = LBound(arrData, 2) To UBound(arrData, 2)
                    If Not oDic.exists(arrData(1, j)) Then
                        oDic(arrData(1, j)) = oDic.Count + 1
                    End If
                Next
                ReDim arrRes(1 To UBound(arrData) - 1, 1 To oDic.Count)
                For j = LBound(arrData, 2) To UBound(arrData, 2)
                    iC = oDic(arrData(1, j))
                    For i = LBound(arrData) + 1 To UBound(arrData)
                        arrRes(i - 1, iC) = arrData(i, j)
                    Next
                Next
                ' Write ouput to CombinedData sheet
                cbSht.Cells(iR, 1).Resize(UBound(arrRes), oDic.Count).Value = arrRes
                iR = iR + UBound(arrRes)
            End If
        End If
    Next
    
    ' Populate headers
    ReDim arrRes(0, 1 To oDic.Count)
    i = 0
    For Each vKey In oDic.Keys
        i = i + 1
        arrRes(0, i) = vKey
    Next
    cbSht.Cells(1, 1).Resize(1, oDic.Count).Value = arrRes
    
    ' Copy out the final sheet
    Sheets("CombinedData").Columns("I:GN").NumberFormat = "0.00"
    
    LastCol = Sheets("CombinedData").Cells(1, Sheets("CombinedData").Columns.Count).End(xlToLeft).Column
    LastRow = Sheets("CombinedData").Cells(Sheets("CombinedData").Rows.Count, "H").End(xlUp).Row
    
    Set rngData = Sheets("CombinedData").Range("I2", Sheets("CombinedData").Cells(LastRow, LastCol))
    
    rngData.Replace What:="false", Replacement:=""
    rngData.Replace What:="N/A", Replacement:=""
    rngData.Replace What:="NA", Replacement:=""
    rngData.Replace What:="#VALUE!", Replacement:=""
    
    Set rngData = Sheets("CombinedData").Range("A1", Sheets("CombinedData").Cells(LastRow, LastCol))
    rngData.Replace What:=",", Replacement:=""
    
    ' Sheets("CombinedData").Columns("C:C").Replace What:="Bet365", Replacement:=""
    
    ThisWorkbook.Sheets("CombinedData").Copy
    ActiveWorkbook.SaveAs Filename:="\\filepath\Gaming_Revenue.csv", FileFormat:=xlCSV, CreateBackup:=True
    ActiveWorkbook.Close
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

报错代码

Option Explicit

Sub Demo_testing()
    Dim i As Long, j As Long, LastRow As Long, LastCol As Long, ColCnt As Long, arrRes As Long, iR As Long, iC As Long, iRes As Long
    Dim vKey As Range, oDic As Range, arrData As Range, rngData As Range, cell As Range
    Dim oSht As Worksheet, cbSht As Worksheet, ws As Worksheet, ignore1 As Worksheet, ignore2 As Worksheet
    Dim sheetName As Variant, sheetsToKeep As Variant
    Dim found As Boolean
    Const CB_SHT = "CombinedData"
    
    'remove unneeded sheets
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Sheets(Array("About", "Overview_Total", "Overview_Casino", "Overview_Sports", "Overview_iGaming", "Statewide")).Delete

    'Fix the RI opened data
    Sheets("RI").Columns("C:C").Replace What:="1993", Replacement:=""
    
    'All Caps headers
    For Each oSht In ThisWorkbook.Sheets
        oSht.Activate
        With Rows(1)
        .Value = Evaluate("SUBSTITUTE(SUBSTITUTE(TRIM(INDEX(UPPER(" & .Address(External:=True) & "),)), "","", "|" )," " ,"_")")
        End With
    Next oSht
    
    'Rename betting tab
    Sheets("Betting by Sport").Name = "Sports_Betting"
    
    'Reformat Distributed and Sports betting to new workbooks
    Sheets("Distributed").Columns("F:J").NumberFormat = "0.00"
    Sheets("Distributed").Columns("K:Z").Delete
    
    Sheets("Sports_Betting").Columns("E:AJ").NumberFormat = "0.00"
    
    ' Create Gaming_Revenue sheet
    On Error Resume Next
    Set cbSht = Sheets(CB_SHT)
    On Error GoTo 0
    If cbSht Is Nothing Then
        Set cbSht = Sheets.Add
        cbSht.Name = CB_SHT
    Else
        cbSht.Cells.Clear
    End If
    Set oDic = CreateObject("scripting.dictionary")
    iR = 2
    
    Set ignore1 = Sheets("Distributed")
    Set ignore2 = Sheets("Sports_Betting")
    
    For Each oSht In Worksheets
        If oSht.Name <> CB_SHT And oSht.Name <> ignore1 And oSht.Name <> ignore2 Then
            LastRow = oSht.Cells(oSht.Rows.Count, "A").End(xlUp).Row
            If LastRow > 1 Then
                LastCol = oSht.Cells(1, oSht.Columns.Count).End(xlToLeft).Column
                Set rngData = oSht.Range("A1", oSht.Cells(LastRow, LastCol))
                arrData = rngData.Value ' load data into an array
                For j = LBound(arrData, 2) To UBound(arrData, 2)
                    If Not oDic.exists(arrData(1, j)) Then
                        oDic(arrData(1, j)) = oDic.Count + 1
                    End If
                Next
                ReDim arrRes(1 To UBound(arrData) - 1, 1 To oDic.Count)
                For j = LBound(arrData, 2) To UBound(arrData, 2)
                    iC = oDic(arrData(1, j))
                    For i = LBound(arrData) + 1 To UBound(arrData)
                        arrRes(i - 1, iC) = arrData(i, j)
                    Next
                Next
                ' Write ouput to Gaming_Revenue sheet
                cbSht.Cells(iR, 1).Resize(UBound(arrRes), oDic.Count).Value = arrRes
                iR = iR + UBound(arrRes)
            End If
        End If
    Next
    
    ' Populate headers
    ReDim arrRes(0, 1 To oDic.Count)
    i = 0
    For Each vKey In oDic.Keys
        i = i + 1
        arrRes(0, i) = vKey
    Next
    cbSht.Cells(1, 1).Resize(1, oDic.Count).Value = arrRes
    
    ' Copy out the final sheet
    Sheets("CombinedData").Columns("I:GN").NumberFormat = "0.00"
    
    LastCol = Sheets("CombinedData").Cells(1, Sheets("CombinedData").Columns.Count).End(xlToLeft).Column
    LastRow = Sheets("CombinedData").Cells(Sheets("CombinedData").Rows.Count, "H").End(xlUp).Row
    
    Set rngData = Sheets("CombinedData").Range("I2", Sheets("CombinedData").Cells(LastRow, LastCol))
    
    rngData.Replace What:="false", Replacement:=""
    rngData.Replace What:="N/A", Replacement:=""
    rngData.Replace What:="NA", Replacement:=""
    rngData.Replace What:="#VALUE!", Replacement:=""
    
    Set rngData = Sheets("CombinedData").Range("A1", Sheets("CombinedData").Cells(LastRow, LastCol))
    rngData.Replace What:=",", Replacement:=""
    
    Sheets("CombinedData").Columns("C:C").Replace What:="Bet365", Replacement:=""
    
    ' Array of sheet names to keep
    sheetsToKeep = Array("CombinedData", "Sports_Betting", "Distributed")

    ' Loop through all sheets in the workbook
    For Each ws In ThisWorkbook.Sheets
        found = False
        ' Check if the current sheet is in the array
        For Each sheetName In sheetsToKeep
            If ws.Name = sheetName Then
                found = True
                Exit For
            End If
        Next sheetName
        ' Delete the sheet if it's not in the array
        If Not found Then
            ws.Delete
        End If
    Next ws
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

错误原因及修复方案

1. 核心变量类型定义错误

报错代码中多个变量类型定义完全错误，导致后续操作失败：

oDic是Scripting.Dictionary对象，却被定义为Range类型，无法正常执行字典操作
arrData是从单元格读取的数组，被定义为Range类型，导致LBound/UBound数组操作报错
arrRes是存储合并结果的数组，被定义为Long数值类型，无法执行ReDim数组重定义
vKey是字典的键值，被定义为Range类型，无法遍历字典键

2. 工作表名称判断逻辑错误

oSht.Name <> ignore1是拿工作表名称和Worksheet对象直接比较，永远返回True，导致本该忽略的工作表被纳入合并逻辑，同时引发类型不匹配。

修复后的代码

Option Explicit

Sub Demo_testing()
    Dim i As Long, j As Long, LastRow As Long, LastCol As Long, ColCnt As Long, iR As Long, iC As Long, iRes As Long
    Dim vKey As Variant, oDic As Object, arrData As Variant, rngData As Range, cell As Range
    Dim arrRes As Variant
    Dim oSht As Worksheet, cbSht As Worksheet, ws As Worksheet, ignore1 As Worksheet, ignore2 As Worksheet
    Dim sheetName As Variant, sheetsToKeep As Variant
    Dim found As Boolean
    Const CB_SHT = "CombinedData"
    
    'remove unneeded sheets
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Sheets(Array("About", "Overview_Total", "Overview_Casino", "Overview_Sports", "Overview_iGaming", "Statewide")).Delete

    'Fix the RI opened data
    Sheets("RI").Columns("C:C").Replace What:="1993", Replacement:=""
    
    'All Caps headers
    For Each oSht In ThisWorkbook.Sheets
        oSht.Activate
        With Rows(1)
            .Value = Evaluate("SUBSTITUTE(SUBSTITUTE(TRIM(INDEX(UPPER(" & .Address(External:=True) & "),)), "","", "|" )," " ,"_")")
        End With
    Next oSht
    
    'Rename betting tab
    Sheets("Betting by Sport").Name = "Sports_Betting"
    
    'Reformat Distributed and Sports betting sheets
    Sheets("Distributed").Columns("F:J").NumberFormat = "0.00"
    Sheets("Distributed").Columns("K:Z").Delete
    Sheets("Sports_Betting").Columns("E:AJ").NumberFormat = "0.00"
    
    ' Create CombinedData sheet
    On Error Resume Next
    Set cbSht = Sheets(CB_SHT)
    On Error GoTo 0
    If cbSht Is Nothing Then
        Set cbSht = Sheets.Add
        cbSht.Name = CB_SHT
    Else
        cbSht.Cells.Clear
    End If
    Set oDic = CreateObject("scripting.dictionary")
    iR = 2
    
    Set ignore1 = Sheets("Distributed")
    Set ignore2 = Sheets("Sports_Betting")
    
    For Each oSht In Worksheets
        ' 修正：使用工作表名称属性进行比较
        If oSht.Name <> CB_SHT And oSht.Name <> ignore1.Name And oSht.Name <> ignore2.Name Then
            LastRow = oSht.Cells(oSht.Rows.Count, "A").End(xlUp).Row
            If LastRow > 1 Then
                LastCol = oSht.Cells(1, oSht.Columns.Count).End(xlToLeft).Column
                Set rngData = oSht.Range("A1", oSht.Cells(LastRow, LastCol))
                arrData = rngData.Value ' load data into an array
                For j = LBound(arrData, 2) To UBound(arrData, 2)
                    If Not oDic.exists(arrData(1, j)) Then
                        oDic(arrData(1, j)) = oDic.Count + 1
                    End If
                Next
                ReDim arrRes(1 To UBound(arrData) - 1, 1 To oDic.Count)
                For j = LBound(arrData, 2) To UBound(arrData, 2)
                    iC = oDic(arrData(1, j))
                    For i = LBound(arrData) + 1 To UBound(arrData)
                        arrRes(i - 1, iC) = arrData(i, j)
                    Next
                Next
                ' Write output to CombinedData sheet
                cbSht.Cells(iR, 1).Resize(UBound(arrRes), oDic.Count).Value = arrRes
                iR = iR + UBound(arrRes)
            End If
        End If
    Next
    
    ' Populate headers
    Re

VBA代码修改后出现Array Expected错误排查求助

正常运行的代码 #

报错代码 #

错误原因及修复方案 #

1. 核心变量类型定义错误 #

2. 工作表名称判断逻辑错误 #