VBA-Ubound Lbound 错误

Question

我需要帮助，请我编写下面的代码，但它在“For i = LBound(header, 2) To UBound(header, 2)”行抛出错误 13 类型不匹配。问题出在哪里？

Function Get_Header_Dico(ByVal header As Variant, _
                         ByVal header_line As Long) As Dictionary

    Dim i               As Long
    Dim headerDict      As Dictionary

    Set headerDict = New Dictionary

    For i = LBound(header, 2) To UBound(header, 2)
        If Not headerDict.Exists(header(header_line, i)) Then
            headerDict.Add header(header_line, i), i
        Else
            MsgBox "Please check data header, there is a duplicate"
            End
        End If
    Next i

    Set Get_Header_Dico = headerDict
End Function

我正在尝试比较 2 个工作簿。下面是调用代码：

Sub Find_Differences()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim data1, data2
    Dim header As Dictionary, data1_Dico As Dictionary, data2_Dico As Dictionary
    Dim different_Dico As Dictionary
    Dim key, tmp, result
    Dim transaction_Type As String, ISIN As String, NAV_Date As String, value_Date As String, nature As String, amount As String
    Dim i As Long, j As Long, lastRow As Long
    Dim sBook As String

If Workbooks.Count < 2 Then
MsgBox "Erreur: Un seul fichier est ouvert" & vbCr & _
"Ouvrir un 2eme fichier et exécuter le macro"
Exit Sub
End If

Set wb1 = ThisWorkbook
For Each wb2 In Workbooks
If wb2.Name <> wb1.Name Then Exit For
Next

ReDo1:
Application.DisplayAlerts = False
sBook = Application.InputBox(prompt:= _
"Comparer ce fichier (" & wb1.Name & ") avec...?", _
Title:="Compare to what workbook?", _
Default:=wb2.Name, Type:=2)
If sBook = "False" Then Exit Sub
If Workbooks(sBook) Is Nothing Then
MsgBox "Fichier: " & sBook & " n'est pas ouvert."
GoTo ReDo1
Else
Set wb2 = Workbooks(sBook)
End If

    Set header = Get_Header_Dico(data1, 1)

    Set data1_Dico = New Dictionary
    For i = 2 To UBound(data1, 1)
        transaction_Type = data1(i, header("Transaction Type"))
        ISIN = data1(i, header("ISIN Code"))
        NAV_Date = Format(data1(i, header("NAV Date")), "dd/mm/yyyy")
        value_Date = Format(data1(i, header("Value Date")), "dd/mm/yyyy")
        nature = data1(i, header("Investment Type"))
        If nature = "Unit" Then
            amount = Format(data1(i, header("Share Nb.")), "#0.0000")
        ElseIf nature = "Amount" Then
            amount = Format(data1(i, header("Fund Amount (Client Cur.)")), "#0.0000")
        End If

        key = transaction_Type & "#" & ISIN & "#" & NAV_Date & "#" & value_Date & "#" & nature & "#" & amount
        If Not data1_Dico.Exists(key) Then
            data1_Dico.Add key, i
        End If

    Next i

    Set header = Get_Header_Dico(data2, 1)

    Set data2_Dico = New Dictionary
    For i = 2 To UBound(data2, 1)
        transaction_Type = data2(i, header("S/R type"))
        ISIN = data2(i, header("Fund share code"))
        NAV_Date = Format(data2(i, header("Pricing Date")), "dd/mm/yyyy")
        value_Date = Format(data2(i, header("Value Date")), "dd/mm/yyyy")
        nature = data2(i, header("Nature"))
        If nature = "Unit" Then
            amount = Format(data2(i, header("Quantity")), "#0.0000")
        ElseIf nature = "Amount" Then
            amount = Format(data2(i, header("Net amount")), "#0.0000")
        End If

        key = transaction_Type & "#" & ISIN & "#" & NAV_Date & "#" & value_Date & "#" & nature & "#" & amount
        If Not data2_Dico.Exists(key) Then
            data2_Dico.Add key, i
        End If
    Next i

    Set different_Dico = New Dictionary
    For Each key In data1_Dico.Keys
        If Not data2_Dico.Exists(key) Then
            different_Dico.Add key, key
        End If
    Next key

    ReDim result(1 To different_Dico.Count, 0 To 5)
    i = 0
    For Each key In different_Dico.Keys
        tmp = Split(key, "#")
        i = i + 1
        For j = 0 To UBound(tmp)
            result(i, j) = tmp(j)
        Next j
    Next key

    With ThisWorkbook.Sheets("Differences")
        .Cells.Clear
        .Range("A1").Resize(UBound(result, 1), UBound(result, 2) + 1) = result
    End With

    Set different_Dico = New Dictionary
    For Each key In data2_Dico.Keys
        If Not data1_Dico.Exists(key) Then
            different_Dico.Add key, key
        End If
    Next key

    ReDim result(1 To different_Dico.Count, 0 To 5)
    i = 0
    For Each key In different_Dico.Keys
        tmp = Split(key, "#")
        i = i + 1
        For j = 0 To UBound(tmp)
            result(i, j) = tmp(j)
        Next j
    Next key

    With ThisWorkbook.Sheets("Differences")
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("A" & lastRow + 2).Resize(UBound(result, 1), UBound(result, 2) + 1) = result
    End With

    ThisWorkbook.Sheets("Differences").Activate

End Sub

Answer 1

您假设header 将是一个变体数组；这并不总是正确的，正如John Coleman 指出的那样，您最好检查一下类型。

这是一个常见错误，根本原因是：

将 Excel Range 对象传递到 Excel VBA 函数中的变体参数不会将传入数据转换为变体数据类型。

是的，我们知道“强制转换”的预期行为是对象将使用其默认属性填充变体，而范围的默认属性属性是 .Value 变体 - 但您实际得到的结果是您的“变体”是 Excel 范围。

所以您的变体header 包含对对象的引用。

现在有一些函数——UBound() 和 LBound() 浮现在脑海——它们希望看到一个数组，将自动将范围的默认 .Value 属性转换为变量数组。但是……

如果您传入的是单个单元格区域，则该区域的 .Value 属性不是数组。

...对于单个单元格范围，它是一个标量变体；该类型是从单元格的.NumberFormat 属性推断的字符串或数字或日期时间类型，并且任何期望数组的函数在得到该数组时都会抛出类型错误。是的，UBound() 和 LBound() 再次浮现在脑海中：它们会正常工作，直到您通过单细胞范围的那一天。

范围内的其他内容会破坏“下游”函数，这些函数可以处理电子表格中的简单数据网格：我猜你有最常见的例子，一个单元格；但是 Range 类型的未初始化 Nothing 对象变量可能会在代码中深入到引发类型错误的程度：非连续范围（数组数组，每个项目对应于 .value 属性range 的 .Areas 集合）。

如果我们幸运的话，其他 'Stackers 会评论并列出更多奇特的例子；很可能是我从未听说过的平凡示例，否则我会在我自己的代码完全停止在您今天所做的位置时发现。

所以你的问题的答案是检查传入的参数，几乎完全按照 John Coleman 的建议，然后用你的数据填充一个内部变量：

Dim arrData As Variant

'If TypeOf header IS Excel.Range Then ' replaced by 'TypeName', which is more robust

If TypeName(header) = "Range" Then

    If header.Areas(1).Cells.Count = 1 Then
        Redim arrData(1 To 1, 1 To 1)
        arrData(1, 1) = header.Areas(1).Value2
    Else
        arrData = header.Areas(1).Value2
    End If

Else

    If Instr(TypeName(header),"(") > 1 Then 'This is more reliable than IsArray()
        arrData = header
    Else
        Redim arrData(1 To 1, 1 To 1)
        arrData(1, 1) = header
    End If

End If

' ...And run arrData through your code, instead of 'header'

几乎完全按照 John 的建议：在“TypeName”中搜索括号是检测数组的一种比使用 varType 更可靠的方法。

还建议您对从 Excel 范围获得的任何变体的内容运行 IsError()：一旦导入 VBA，范围中的公式错误就很难处理 - 没有 VBA 函数或运算符可以处理它们。

故事的寓意是：

编写一个从工作表中获取数据的函数总是涉及比您预期更多的防御性编码。

让我们知道你的进展情况！