我需要帮助plz我编写了下面的代码，但它在“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
答案 0 :(得分：2)
您假设header将是变体数组;这并非总是如此，正如John Coleman指出的那样，你最好检查一下类型。
这是一个常见错误，其根本原因是：
将Excel范围对象传递到Excel VBA函数中的变量参数中不将传入数据强制转换为变体数据类型。
是的，我们知道'cast'的预期行为是一个对象将使用它的默认属性填充变体，并且范围的默认属性属性是.Value变体 - 但结果是实际得到的是你的'变种'是Excel范围。
因此，您的变体header包含对象的引用。
现在有一些函数 - UBound（）和LBound（）让人想起 - 期望看到一个数组，将自动将范围的默认.Value属性转换为变量数组。但...
如果您传入了单格范围，则该范围的.Value属性不是数组。
...而且，对于单细胞范围，它是标量变体; type是从单元格的.NumberFormat属性推断出的字符串或数字或日期时间类型，并且任何期望数组的函数在得到它时都会抛出类型错误。是的，UBound（）和LBound（）再次浮现在脑海中：它们会很好地工作，直到你通过单细胞范围的那一天。
范围内的其他内容会打破“下游”功能，可以处理来自电子表格的简单数据网格：我猜你有最常见的例子，一个单元格;但是Range类型的未初始化的Nothing对象变量可能会在代码中得到足够的提升类型错误：非连续范围（数组数组，每个项目对应于.value属性）范围的.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'
建议您对从Excel范围获取的任何变体的内容运行IsError()：一旦导入到VBA中，范围内的公式错误是难以处理的 - 没有VBA函数或操作符可以处理它们。
故事的寓意是：
编写一个从工作表中获取数据的函数总是涉及比预期更多的防御性编码。
告诉我们你是如何上场的！