2016-04-11 9 views
2

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 
+2

Es scheint, dass der 'header' Wert, den Sie übergeben, kein Array ist. – Rory

+1

'header' darf kein Array sein. Setzen Sie 'Debug.Print TypeName (header)' vor die betreffende Zeile und sehen Sie, was Sie bekommen. –

+0

Versuchen Sie, die Zeile "Wenn TypeName (header) =" Bereich "Dann header = header.Value" vor der Zeile, die den Fehler auslöst. –

Antwort

2

Sie gehen davon aus, dass header eine Variante Array sein wird; Dies ist nicht immer richtig und, wie bereits erwähnt, wäre es gut, den Typ zu überprüfen.

Dies ist ein häufiger Fehler, und die zugrunde liegende Ursache ist:

Passing ein Excel-Range-Objekt in eine Variante Parameter in einer Excel-Funktion tut VBA nicht die ankommenden Daten auf einen Variante Datentyp umgewandelt.

Ja, wir wissen, dass das erwartete Verhalten der ist ‚werfen‘, dass ein Objekt eine Variante bevöl damit Standardeigenschaft ist, und die Standardeigenschaft Eigenschaft eines Bereichs ist die .Value Variante - aber das Ergebnis, das Sie tatsächlich bekommen ist, dass Ihre 'Variante' ein Excel-Bereich ist.

Ihre Variante header enthält also einen Verweis auf ein Objekt.

Nun gibt es einige Funktionen - UBound() und LBound() in dem Sinne - was erwartet ein Array zu sehen und wird werfen automatisch der Standard .Value Eigenschaft als Variante Arrays Bereichs. Aber ...

Wenn Sie in einem einzelligen Bereich bestanden haben, ist die .Value-Eigenschaft des Bereichs kein Array.

... und für einen einzelligen Bereich ist es eine skalare Variante; Der Typ ist ein String oder eine Zahl oder ein Datetime-Typ, der aus der .NumberFormat-Eigenschaft der Zelle abgeleitet wird, und alle Funktionen, die ein Array erwarten, werden einen Typfehler ausgeben, wenn sie das bekommen. Ja, UBound() und LBound() kommen einem gleich wieder in den Sinn: Sie werden gut funktionieren, bis zu dem Tag, an dem du in einem einzelligen Bereich vorbeikommst.

Andere Dinge in einer Reihe werden "Downstream" -Funktionen unterbrechen, die mit einem einfachen Raster von Daten aus der Tabelle zurechtkommen: Ich nehme an, dass Sie das häufigste Beispiel haben, eine einzelne Zelle; aber eine nicht initialisierte Nothing Objektvariable vom Typ Range könnte auch weit genug in den Code kommen, um einen Type-Fehler auszulösen, ebenso wie ein nicht zusammenhängender Bereich (ein Array von Arrays, wobei jedes Element den .value-Eigenschaften des Bereichs entspricht. Bereiche Sammlung).

Wenn wir Glück haben, werden andere Stacker noch exotischere Beispiele kommentieren und aufführen; und vielleicht sogar weltliche Beispiele, von denen ich noch nie gehört habe und die ich sonst entdecken würde, wenn mein eigener Code exakt dort aufhört, wo er heute ist.

So ist die Antwort auf Ihre Frage ist die eingehenden Parameter zu überprüfen, fast genau wie John Coleman vorgeschlagen, und dann eine interne Variable mit Daten füllen:

 
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'
Fast genau wie John vorgeschlagen: Suche 'TypeName' für Klammern ist eine robustere Methode zur Erkennung eines Arrays als die Verwendung von varType.

Sie wären auch gut beraten, IsError() für den Inhalt jeder Variante aus einem Excel-Bereich auszuführen: Einmal in VBA importiert, sind Formelfehler in einem Bereich unlösbar - keine VBA-Funktion oder Operator kann damit umgehen.

Und die Moral von der Geschichte ist:

Schreiben eine Funktion, die Daten aus dem Arbeitsblatt nimmt beinhaltet immer mehr defensive Codierung als erwartet.

Lassen Sie uns wissen, wie es Ihnen geht!

+0

Vielen Dank, aber ich habe benutzerdefinierte Typ nicht in der Zeile definiert "Funktion Get_Header_Dico (ByVal-Header als Variante, _ ByVal Header_line als lang) als Dictionary". Wo ist das Problem? – shinpencil

+0

Ich habe auch Fehler 91 in der Zeile "Wenn TypeOf Header ist Excel.Range dann" – shinpencil

+0

Sie erhalten einen unbekannten Typ Fehler bei 'Funktion Get_Header_Dico (ByVal-Header als Variante, _ ByVal Header_Linie als lang) als Dictionary'? Ihr VBA-Projekt weiß nicht, was ein "Wörterbuch" ist: Öffnen Sie das Menü "Extras", öffnen Sie "Referenzen" und erstellen Sie einen Verweis auf die Windows Scripting Runtime - das ist die Bibliothek, die Sie für einen Verweis auf die Skripterstellung benötigen. Dictionary' Objekt. –