Excel VBA非连续范围数组赋值#REF!错误求助

问题描述 #

现有VBA代码可根据Main工作表B5单元格输入的零件号，在SHORTAGE和PPN工作表中搜索并返回对应数据。需将SHORTAGE表的数据读取范围从B:F列修改为A:F列、L列、N列，但尝试Union合并范围或直接用逗号分隔范围赋值给数组时，仅A:F列能返回正确值，L、N列全部返回#REF!错误。

原代码 #

Sub Button2_Click()
Dim partNum As String
Dim mainSheet As Worksheet
Dim shortageSheet As Worksheet
Dim ppnSheet As Worksheet
Dim mainLastRow As Long
Dim shortageLastRow As Long
Dim ppnLastRow As Long
Dim shortageData As Variant
Dim ppnData As Variant
Dim i As Long
Dim recordFound As Boolean
Application.ScreenUpdating = False
Set mainSheet = ThisWorkbook.Sheets("Main")
Set shortageSheet = ThisWorkbook.Sheets("SHORTAGE")
Set ppnSheet = ThisWorkbook.Sheets("PPN")
partNum = mainSheet.Range("B5").Value
If partNum = "" Then
    MsgBox "Please enter a part number.", vbExclamation
    Exit Sub
End If
mainSheet.Range("B11:F" & mainSheet.Cells(mainSheet.Rows.Count, "B").End(xlDown).Row).ClearContents
mainSheet.Range("I11:O" & mainSheet.Cells(mainSheet.Rows.Count, "I").End(xlDown).Row).ClearContents
shortageLastRow = shortageSheet.Cells(shortageSheet.Rows.Count, "B").End(xlUp).Row
shortageData = shortageSheet.Range("B1:F" & shortageLastRow).Value
For i = 1 To shortageLastRow
    If shortageData(i, 1) = partNum Then
        mainLastRow = mainSheet.Cells(mainSheet.Rows.Count, "B").End(xlUp).Row + 1
        mainSheet.Range("B" & mainLastRow & ":I" & mainLastRow).Value = _
            Application.Index(shortageData, i, Array(1, 2, 3, 4, 5))
        recordFound = True
    End If
Next i
If Not recordFound Then
    MsgBox "No records found in SHORTAGE"
End If
recordFound = False
ppnLastRow = ppnSheet.Cells(ppnSheet.Rows.Count, "G").End(xlUp).Row
ppnData = ppnSheet.Range("G1:N" & ppnLastRow).Value
For i = 1 To ppnLastRow
    If ppnData(i, 1) = partNum Then
        mainLastRow = mainSheet.Cells(mainSheet.Rows.Count, "I").End(xlUp).Row + 1
        mainSheet.Range("I" & mainLastRow & ":O" & mainLastRow).Value = _
            Application.Index(ppnData, i, Array(1, 2, 3, 4, 5, 6, 7, 8))
        recordFound = True
    End If
Next i
If Not recordFound Then
    MsgBox "No records found in PPN"
End If
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Search complete!", vbInformation
End Sub

问题原因 #

VBA将非连续区域赋值给数组时，会生成嵌套多维数组（每个非连续子区域对应一个子数组），而非连续的一维/二维数组。直接使用Application.Index读取时，无法识别非连续区域的列索引，导致返回#REF!错误。

解决方案 #

方法一：手动构建连续数组（高效，适合大数据量） #

手动将需要的列数据逐列写入一个连续的二维数组，避免非连续区域的数组结构问题：

' 替换原代码中shortageData相关的部分
shortageLastRow = shortageSheet.Cells(shortageSheet.Rows.Count, "A").End(xlUp).Row ' 改用A列取最后一行，确保覆盖所有数据
' 初始化连续数组：行数=shortageLastRow，列数=6(A-F)+1(L)+1(N)=8
ReDim shortageData(1 To shortageLastRow, 1 To 8)

' 写入A-F列（对应数组第1-6列）
Dim col As Long
For col = 1 To 6
    shortageData(1 To shortageLastRow, col) = Application.Transpose(shortageSheet.Range(shortageSheet.Cells(1, col), shortageSheet.Cells(shortageLastRow, col)).Value)
Next col

' 写入L列（对应数组第7列）
shortageData(1 To shortageLastRow, 7) = Application.Transpose(shortageSheet.Range("L1:L" & shortageLastRow).Value)
' 写入N列（对应数组第8列）
shortageData(1 To shortageLastRow, 8) = Application.Transpose(shortageSheet.Range("N1:N" & shortageLastRow).Value)

' 后续循环搜索部分，调整Index的列数组（根据需要返回的列对应数组的索引）
For i = 1 To shortageLastRow
    If shortageData(i, 2) = partNum Then ' 零件号在原B列，对应数组第2列
        mainLastRow = mainSheet.Cells(mainSheet.Rows.Count, "B").End(xlUp).Row + 1
        ' 假设需要返回A-F、L、N列到Main表的B:I列，对应数组第1-8列
        mainSheet.Range("B" & mainLastRow & ":I" & mainLastRow).Value = _
            Application.Index(shortageData, i, Array(1,2,3,4,5,6,7,8))
        recordFound = True
    End If
Next i

方法二：逐行读取非连续区域（直观，适合小数据量） #

跳过数组赋值，直接遍历SHORTAGE表的每一行，找到匹配的零件号后，直接读取对应非连续列的值到Main表：

' 替换原代码中shortageData相关的部分
shortageLastRow = shortageSheet.Cells(shortageSheet.Rows.Count, "B").End(xlUp).Row
recordFound = False

For i = 1 To shortageLastRow
    If shortageSheet.Cells(i, "B").Value = partNum Then ' 直接读取B列的零件号
        mainLastRow = mainSheet.Cells(mainSheet.Rows.Count, "B").End(xlUp).Row + 1
        ' 直接将需要的列赋值到Main表，用Union选择非连续列
        Union(shortageSheet.Range("A" & i & ":F" & i), _
              shortageSheet.Range("L" & i), _
              shortageSheet.Range("N" & i)).Copy
        mainSheet.Range("B" & mainLastRow).PasteSpecial xlPasteValues
        recordFound = True
    End If
Next i

注意事项 #

• 方法一中，若行数超过65536，Application.Transpose会报错，此时需改用逐行循环赋值。
• 方法二中，若数据量较大，效率会低于方法一，建议优先使用方法一。

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