从Excel区域创建VBA数组时遭遇数据类型不匹配问题

问题背景 #

有两组Excel整数数据，需要用VBA对比：新数据会覆盖旧数据区域，之后要记录参数变化。数据格式如下：

现有代码及错误情况 #

代码片段如下：

...
Sub sub1()

new_rows = ThisWorkbook.Sheets("new").Cells.SpecialCells(xlCellTypeLastCell).Row
old_rows = ThisWorkbook.Sheets("old").Cells.SpecialCells(xlCellTypeLastCell).Row
Dim new_data() As Variant
Dim old_data() As Variant
new_data = ThisWorkbook.Sheets("new").Range("A1:G" & new_rows).Value
old_data = ThisWorkbook.Sheets("old").Range("A1:G" & old_rows).Value
...
Dim update_tracker() As Variant
ReDim update_tracker(rows, columns)
...
updates_recorded = 0
For row_new = 2 To new_rows
     ID = new_data(row_new, 1)
     [匹配old_data中相同ID对应行的代码]

     new_Parameter_1 = new_data(row_new, 4)
     old_Parameter_1 = old_data(row_old, 4)
     new_Parameter_2 = etc....
     [其他所有数据参数]

     If new_Parameter_1 <> old_Parameter_1 Then
          update_tracker = track_updates(update_tracker, updates_recorded, ID, old_Parameter_1, new_Parameter_1, 1)
          updates_recorded = updates_recorded + 1
     End If
     [其他参数的if判断语句]
Next row_new
[将数据写入Excel的无关代码]
End Sub

Function track_updates(update_tracker, updates_recorded, ID, old_Parameter, new_Parameter, parameter_number)
     If updates_recorded > 0 Then
          ReDim Preserve update_tracker(start To UBound(update_tracker, 1), [same columns])
     End If
     update_tracker(UBound(update_tracker, 1), col_1) = ID
     update_tracker(UBound(update_tracker, 1), col_2) = old_Parameter
     update_tracker(UBound(update_tracker, 1), col_3) = new_Parameter
     update_tracker(UBound(update_tracker, 1), col_4) = parameter_number

     track_updates = update_tracker
End Function

遇到的问题：

• 执行old_data = ThisWorkbook.Sheets("old").Range("A1:G" & old_rows).Value时触发Type mismatch错误，无论数组声明为Integer还是Double都会报错。
• 用VarType([range].Value)检查新旧数据区域，均返回8204（Variant数组标识），但仅新数据表的数据能正常存入数组。
• 改为所有数组声明为Variant后，数据读取部分可运行，但后续将ID存入update_tracker时仍出现相同错误，调试时VarType(ID)返回5（Double类型）。
• 尝试另一种读取方式，old_data数组全为0：

Dim old_data() As Variant
Dim r As Range
Set r = ThisWorkbook.Sheets("old").Range("A1:G" & old_rows)
old_data = r

解决方案 #

1. 修正数据行号获取逻辑 #

SpecialCells(xlCellTypeLastCell)依赖Excel的"已使用区域"缓存，若工作表曾有过数据后被清空，会返回错误的行号，导致读取区域包含大量空单元格引发类型不匹配。改用更可靠的行号获取方式：

' 从A列（ID列）获取有效数据最后一行
new_rows = ThisWorkbook.Sheets("new").Cells(ThisWorkbook.Sheets("new").Rows.Count, "A").End(xlUp).Row
old_rows = ThisWorkbook.Sheets("old").Cells(ThisWorkbook.Sheets("old").Rows.Count, "A").End(xlUp).Row

2. 修复动态数组初始化与扩容问题 #

update_tracker的初始化和ReDim Preserve存在语法错误，VBA动态数组扩容时仅能修改最后一维，需明确初始维度：

' 初始化跟踪数组为1行4列（对应ID、旧值、新值、参数编号）
Dim update_tracker() As Variant
ReDim update_tracker(1 To 1, 1 To 4)
updates_recorded = 0

修改track_updates函数：

Function track_updates(update_tracker As Variant, updates_recorded As Long, ID As Double, old_Parameter As Integer, new_Parameter As Integer, parameter_number As Integer) As Variant
    updates_recorded = updates_recorded + 1
    ' 仅扩容行维度（VBA允许修改最后一维，这里列是第二维固定）
    ReDim Preserve update_tracker(1 To updates_recorded, 1 To 4)
    
    update_tracker(updates_recorded, 1) = ID
    update_tracker(updates_recorded, 2) = old_Parameter
    update_tracker(updates_recorded, 3) = new_Parameter
    update_tracker(updates_recorded, 4) = parameter_number
    
    track_updates = update_tracker
End Function

3. 明确变量类型避免隐式转换 #

所有变量提前声明类型，避免VBA隐式转换导致的类型不匹配：

Sub sub1()
    Dim new_rows As Long, old_rows As Long
    Dim new_data() As Variant, old_data() As Variant
    Dim update_tracker() As Variant
    Dim row_new As Long, row_old As Long
    Dim ID As Double
    Dim new_Parameter_1 As Integer, old_Parameter_1 As Integer
    Dim updates_recorded As Long
    
    ' 正确获取最后一行
    new_rows = ThisWorkbook.Sheets("new").Cells(Rows.Count, "A").End(xlUp).Row
    old_rows = ThisWorkbook.Sheets("old").Cells(Rows.Count, "A").End(xlUp).Row
    
    ' 读取数据
    new_data = ThisWorkbook.Sheets("new").Range("A1:G" & new_rows).Value
    old_data = ThisWorkbook.Sheets("old").Range("A1:G" & old_rows).Value
    
    ' 初始化跟踪数组
    ReDim update_tracker(1 To 1, 1 To 4)
    updates_recorded = 0
    
    For row_new = 2 To new_rows
        ID = new_data(row_new, 1)
        ' 匹配old_data中相同ID的行（示例实现）
        row_old = 0
        For row_old = 2 To old_rows
            If old_data(row_old, 1) = ID Then Exit For
        Next row_old
        
        If row_old > old_rows Then
            ' 未找到对应ID，可添加自定义逻辑
            GoTo NextRow
        End If
        
        new_Parameter_1 = new_data(row_new, 2) ' 假设Parameter_1在B列（第2列）
        old_Parameter_1 = old_data(row_old, 2)
        
        If new_Parameter_1 <> old_Parameter_1 Then
            update_tracker = track_updates(update_tracker, updates_recorded, ID, old_Parameter_1, new_Parameter_1, 1)
            updates_recorded = updates_recorded + 1
        End If
        
        ' 其他参数对比逻辑...
NextRow:
    Next row_new
    
    ' 将跟踪结果写入工作表（示例）
    ThisWorkbook.Sheets("Log").Range("A1").Resize(updates_recorded, 4).Value = update_tracker
End Sub

关键说明 #

• xlCellTypeLastCell易受历史数据影响，优先用End(xlUp)从核心数据列获取最后一行。
• VBA动态数组ReDim Preserve仅支持修改最后一维，因此将行作为第一维、列作为第二维，方便后续扩容。
• Excel单元格中的整数默认以Double类型存储，明确声明ID为Double可避免类型转换错误。

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