Ich brauche Hilfe PLZ Ich schrieb den Code unten, aber es kracht Fehler 13 Typ Mismatch an der Zeile "Für i = LBound (Header, 2) Um UBound (Header, 2)". Wo ist das Problem?VBA-Ubound Lbound Fehler
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
Ich versuche, 2 Arbeitsmappen zu vergleichen. Hier ist die Telefonvorwahl:
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
Es scheint, dass der 'header' Wert, den Sie übergeben, kein Array ist. – Rory
'header' darf kein Array sein. Setzen Sie 'Debug.Print TypeName (header)' vor die betreffende Zeile und sehen Sie, was Sie bekommen. –
Versuchen Sie, die Zeile "Wenn TypeName (header) =" Bereich "Dann header = header.Value" vor der Zeile, die den Fehler auslöst. –