VBA中NewVArray数组读列返回空 无法写入未匹配数据到Rolls表

NewVArray读取278行返回空值、未匹配值无法写入Rolls工作表，是4处核心代码错误导致的：

• 数组声明、维度定义错位：VBA中Dim OldVArray(), NewVArray(), RollArray() As String的写法仅最后一个RollArray为字符串类型，前两个数组默认是变体型；Redim重定义时OldVArray起始下标为1，但填充循环从a=2启动，数组第一行永远是空值；NewVArray重定义时取A列最后行号作为上界，填充循环却取E列最后行号，两列行数不一致时就会出现越界、漏读行的问题，这就是278行读不到值的直接原因。
• 空值判断逻辑失效：VBA中空单元格返回值为Empty，不是空字符串""，用<> ""做判断既无法过滤真正的空单元格，还会把首尾带空格的无效值误判为有效数据。
• 匹配、写入逻辑混乱：内层循环只要检测到新表航次和旧表不相等，就直接遍历整个NewVArray把Roll表整列C的值赋值给voyage2变量，既没有实现“筛选新表存在、旧表不存在的航次”的核心逻辑，也没有去重、写入Roll表的步骤，代码跑完自然不会输出任何结果。
• 类型隐患：循环变量用Integer类型，最大支持值仅32767，数据行数超过这个值会直接溢出报错。

Sub 匹配新增航次写入Rolls表()
    Dim oldsht As Worksheet, newsht As Worksheet, rollsht As Worksheet
    Dim a As Long, b As Long, rollRow As Long
    Dim isMatched As Boolean, existsInRoll As Boolean
    Dim oldLastRow As Long, newLastRow As Long, rollLastRow As Long
    Dim OldVArray, NewVArray, RollArray
    Dim curVoyage As String
    
    ' 绑定目标工作表
    Set oldsht = ThisWorkbook.Sheets("Insert Yesterday's Report Here")
    Set newsht = ThisWorkbook.Sheets("Insert Today's Report Here")
    Set rollsht = ThisWorkbook.Sheets("Rolls")
    
    ' 统一取各表E列/C列的最后有效行号，避免列行数不一致导致的数组错位
    oldLastRow = oldsht.Cells(oldsht.Rows.Count, "E").End(xlUp).Row
    newLastRow = newsht.Cells(newsht.Rows.Count, "E").End(xlUp).Row
    rollLastRow = rollsht.Cells(rollsht.Rows.Count, "C").End(xlUp).Row
    
    ' 直接将单元格区域赋值给数组，无需逐行循环填充，效率更高且不会出现维度错位
    OldVArray = oldsht.Range("E2:E" & oldLastRow).Value
    NewVArray = newsht.Range("E2:E" & newLastRow).Value
    RollArray = rollsht.Range("C2:C" & rollLastRow).Value
    
    rollRow = rollLastRow + 1 ' 从Roll表现有数据的下一行开始写入，避免覆盖原有内容
    
    ' 遍历新表所有航次
    For a = 1 To UBound(NewVArray, 1)
        ' 处理Empty空值，去除首尾多余空格，跳过空单元格
        curVoyage = Trim(IIf(IsEmpty(NewVArray(a, 1)), "", NewVArray(a, 1)))
        If curVoyage <> "" Then
            isMatched = False
            ' 遍历旧表检查当前航次是否存在
            For b = 1 To UBound(OldVArray, 1)
                If Trim(IIf(IsEmpty(OldVArray(b, 1)), "", OldVArray(b, 1))) = curVoyage Then
                    isMatched = True
                    Exit For ' 匹配到即终止循环，减少无效计算
                End If
            Next b
            
            ' 旧表无匹配的航次，再检查Roll表是否已存在，避免重复写入
            If Not isMatched Then
                existsInRoll = False
                For b = 1 To UBound(RollArray, 1)
                    If Trim(IIf(IsEmpty(RollArray(b, 1)), "", RollArray(b, 1))) = curVoyage Then
                        existsInRoll = True
                        Exit For
                    End If
                Next b
                ' 确认无重复则写入Roll表C列
                If Not existsInRoll Then
                    rollsht.Cells(rollRow, "C") = curVoyage
                    rollRow = rollRow + 1
                End If
            End If
        End If
    Next a
End Sub

代码适配了你本地监控到的两种值场景：用IsEmpty()识别返回Empty的空单元格，用Trim()清理首尾带空格的字符串，避免误判。直接区域赋值数组的写法比逐行循环填充效率高数十倍，也不会出现行号错位漏读的问题。

• Oldsheet（昨日报表页）：
  
• Newsheet（今日报表页）：
  
• Rolls（结果汇总页）：
  

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