Excel VBA数组日期格式化操作触发类型不匹配错误求助

问题描述 #

运行VBA处理表格作业数据时，多次触发**类型不匹配（Type Mismatch）**错误：

• 首次报错位置为拼接字典键值的代码行，该行逻辑为拼接作业名称与开始日期作为字典的唯一键：

  mykey = arr(i, 7) & format(arr(i, 11), "|dd-mmm-yy")     'job name & start date
  

• 后续其他涉及数组日期值计算、格式化的代码行也触发同类错误。

相关报错参考：

• 报错截图1
• 报错截图2
• 后续同类报错截图

触发错误的原始完整代码如下：

Dim T_Start, T_Stop, Shift_Start, Shift_Stop, Result    
     Set dict = CreateObject("scripting.dictionary")
     Set lo = Sheets("temp_sheet").ListObjects("TBL_Jobs")   
     arr = lo.DataBodyRange.Value2     'read that table to an array
     ReDim Result(1 To UBound(arr), 1 To 1)


     '1st ROUND : find last status at the end of the shift
    For i = 1 To UBound(arr)     'loop through data
            T_Start = arr(i, 11) + arr(i, 12)     'timestamp end of job
            T_Stop = arr(i, 14) + arr(i, 15)     'timestamp end of job
          
            mykey = arr(i, 7) & format(arr(i, 11), "\|dd-mmm-yy")     'job name & start date
          
        If arr(i, 11) = arr(i, 14) Then
          
            If T_Stop <= arr(i, 11) + TimeSerial(15, 0, 0) Then     'job must end before next day 3PM
               If Not dict.exists(mykey) Then
                    dict(mykey) = Array(T_Stop, arr(i, 10))
               Else
                    If dict(mykey)(0) < T_Stop Then dict(mykey) = Array(T_Stop, arr(i, 10))     '---> for that job and that startdate, the last endmoment & status
               End If
            Else
               Result(i, 1) = "Notwithinshift"
          End If
     
                    
          Else
          
            If T_Stop <= arr(i, 11) + 1 + TimeSerial(15, 0, 0) Then     'job must end before next day 3PM
                 If Not dict.exists(mykey) Then
                      dict(mykey) = Array(T_Stop, arr(i, 10))
                 Else
                      If dict(mykey)(0) < T_Stop Then dict(mykey) = Array(T_Stop, arr(i, 10))     '---> for that job and that startdate, the last endmoment & status
                 End If
            Else
                 Result(i, 1) = "Notwithinshift"
            End If
     
     
        End If
     
    Next

     '2nd ROUND : add status corresponding with status "end of shift"
     For i = 1 To UBound(arr)     'loop through data
          If Len(Result(i, 1)) = 0 Then     'no blocking conditions
            mykey = arr(i, 1) & format(arr(i, 11), "\|dd-mmm-yy")    'key within dictionary
            Result(i, 1) = dict(mykey)(1)     'last known status
          End If
     Next

     lo.ListColumns("Final Status").DataBodyRange.Value = Result     'write array to listobject

End Sub

错误根因定位 #

类型不匹配错误由4个共性问题触发：

• 空值未做校验：代码通过Value2直接读取列表对象全部数据到数组，只要对应列（第7列作业名、第11列开始日期、第12/14/15列时间相关字段）存在空单元格，数组对应位置就会存储Empty值，传入Format()函数、或做日期/时间加法运算时直接触发类型不匹配。
• 字典键生成逻辑不一致：第一轮循环生成字典键用的是arr(i,7)（作业名），第二轮循环匹配键时错误使用arr(i,1)，会导致查询字典时键不存在，后续取字典值索引时触发报错。
• 数据类型未显式转换：Value2读取的日期值本质是双精度数值，如果单元格存储的是文本格式日期，直接做加法运算会触发类型错误。
• 变量未显式声明：所有循环变量、键值变量未定义类型，值类型异常时无法提前捕获，还容易出现索引写错的低级错误。

修复方案 #

• 遍历数组时先校验关键字段是否为空，空值直接标记异常跳过后续计算
• 所有日期、时间字段先通过CDate()做显式类型转换，避免文本格式/数值格式不统一导致的运算错误
• 统一两轮循环的字典键生成逻辑，全部使用作业名+开始日期的组合
• 字典查询前先校验键是否存在，避免不存在的键触发取值错误
• 所有变量显式声明类型，建议模块顶部添加Option Explicit强制变量声明，提前捕获变量名拼写、索引写错类的错误

修复后完整代码 #

Option Explicit
Sub CalcJobFinalStatus()
    Dim T_Start As Date, T_Stop As Date, Result
    Dim dict As Object, lo As ListObject, arr As Variant, i As Long, mykey As String
    Dim jobName As Variant, startDate As Variant, startTime As Variant, endDate As Variant, endTime As Variant, jobStatus As Variant
    
    Set dict = CreateObject("scripting.dictionary")
    Set lo = Sheets("temp_sheet").ListObjects("TBL_Jobs")
    ' 校验列表是否存在有效数据
    If lo.DataBodyRange Is Nothing Then
        MsgBox "表格中无作业数据", vbExclamation
        Exit Sub
    End If
    arr = lo.DataBodyRange.Value2
    ReDim Result(1 To UBound(arr), 1 To 1)

    '1st ROUND : find last status at the end of the shift
    For i = 1 To UBound(arr)
        ' 读取所有关键字段，做空值校验
        jobName = arr(i, 7)
        startDate = arr(i, 11)
        startTime = arr(i, 12)
        endDate = arr(i, 14)
        endTime = arr(i, 15)
        jobStatus = arr(i, 10)
        
        ' 空值直接标记异常，跳过后续计算
        If IsEmpty(jobName) Or IsEmpty(startDate) Or IsEmpty(startTime) _
            Or IsEmpty(endDate) Or IsEmpty(endTime) Or IsEmpty(jobStatus) Then
            Result(i, 1) = "MissingData"
            GoTo NextLoop1
        End If
        
        ' 显式转换为日期类型，统一格式
        startDate = CDate(startDate)
        startTime = CDate(startTime)
        endDate = CDate(endDate)
        endTime = CDate(endTime)
        
        T_Start = startDate + startTime
        T_Stop = endDate + endTime
        ' 统一生成字典键，修正格式串
        mykey = CStr(jobName) & Format(startDate, "|dd-mmm-yy")
        
        If startDate = endDate Then
            If T_Stop <= startDate + TimeSerial(15, 0, 0) Then
                If Not dict.exists(mykey) Then
                    dict(mykey) = Array(T_Stop, jobStatus)
                Else
                    If dict(mykey)(0) < T_Stop Then dict(mykey) = Array(T_Stop, jobStatus)
                End If
            Else
                Result(i, 1) = "Notwithinshift"
            End If
        Else
            If T_Stop <= startDate + 1 + TimeSerial(15, 0, 0) Then
                If Not dict.exists(mykey) Then
                    dict(mykey) = Array(T_Stop, jobStatus)
                Else
                    If dict(mykey)(0) < T_Stop Then dict(mykey) = Array(T_Stop, jobStatus)
                End If
            Else
                Result(i, 1) = "Notwithinshift"
            End If
        End If
NextLoop1:
    Next

    '2nd ROUND : add status corresponding with status "end of shift"
    For i = 1 To UBound(arr)
        If Len(Result(i, 1)) = 0 Then
            ' 统一字典键生成逻辑，和第一轮规则完全一致
            mykey = CStr(arr(i, 7)) & Format(CDate(arr(i, 11)), "|dd-mmm-yy")
            ' 校验键存在后再取值，避免报错
            If dict.exists(mykey) Then
                Result(i, 1) = dict(mykey)(1)
            Else
                Result(i, 1) = "NoMatchingStatus"
            End If
        End If
    Next

    lo.ListColumns("Final Status").DataBodyRange.Value = Result
End Sub

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