Microsoft Excel

Herbers Excel/VBA-Archiv

DRINGEND!!! Fehlermeldung #WERT! bei VBA_Funktion

Betrifft: DRINGEND!!! Fehlermeldung #WERT! bei VBA_Funktion von: Florian Müller
Geschrieben am: 31.10.2014 19:52:07

Hallo,

ich habe mir heute eine "kleine" Funktion in VBA geschrieben.
Sie sollte in Abhängigkeit von einem Anfangsdatum T1 und einem Enddatum T2 automatisch aus einer Tabelle (in einem anderen Tabellenblatt) zwei Werte auslesen. Die Zeilen dieser Tabelle sind nach "Anfangsdaten" untergliedert (,die T1 entsprechen sollen), wohingegen die Spalten dieser Tabelle in kategoriesierte Zeiträume untergliedert sind. In der Tabelle selbst stehen dann die benötigten Werte. Die beiden ermittelten Werte sollten abschließend - falls nötig - interpoliert werden.

Leider spuckt Excel bei Anwendung des Codes die Fehlermeldung #WERT! aus...Bräuchte bitte dringend Hilfe!

Hier der Code, vllt findet jemand meine/n Fehler:

Function MATCHING(ByVal T1 As Double, _
                        ByVal T2 As Double) As Double
                        
                        
    
    
' Dimensionierung der Hilfsvariablen
        
        Dim x As Integer, _
            y As Integer, _
            i As Integer, _
            j As Integer, _
            T_l As Double, _
            T_k As Double, _
            r_l As Double, _
            r_k As Double, _
            Zeile As Double, _
            lambda As Double, _
            RLZ As Double, _
            RLZ_year As Double
        
    ' Restlaufzeit in Tagen
        RLZ = T2 - T1
    ' Restlaufzeit in Jahre
        RLZ_year = Application.WooksheetFunction.YearFrac(T1, T2, 1)
        
' Falls Restlaufzeit <= 1 Jahr Zuordnung zu laufzeitadäquatem EURIBOR:
    If RLZ_year <= 1 Then
        
        ' Prüfung, ob Laufzeit <= 3 Wochen
        If RLZ <= 21 Then
                
                For i = 1 To 3  ' Schleife für Woche 1 bis Woche 3
                    
                    If RLZ <= i * 7 Then
                        
                        x = i + 1
                        T_l = (i * 7) / 360
                            
                        If RLZ <= 7 Then
                            
                            y = 2
                            T_k = 7 / 360
                            
                        ElseIf RLZ = i * 7 Then
                            y = x
                            T_k = T_l
                            
                        Else:
                            y = i
                            T_k = ((i - 1) * 7) / 360
                                
                        End If
                    
                    Exit For
                                                                            
                    End If
                
                Next i
        
        ' Ansonsten: Bestimmung der Laufzeit zwischen 1 und 12 Monaten:
        Else:
        
                For j = 1 To 12 ' Schleife für einen Monat bis zwölf Monate
                    
                    If Application.WorksheetFunction.RoundUp(RLZ_year * 12, 0) = j Then
                        
                        x = j + 4
                        T_l = j / 12
                        
                        If Application.WorksheetFunction.RoundDown(RLZ_year * 12, 0) = j Then
                            y = x
                            T_k = j / 12
                            
                        Else:
                            y = j + 3
                            If y = 4 Then
                                T_k = 21 / 360
                                Else:
                                T_k = (j - 1) / 12
                                End If
                        
                        End If
                        
                    Exit For
                    
                    End If
                
                Next j
                
       End If
       
       
       ' Ablesen der "nächstgelegenen" Zinssätze aus der EURIBOR-Tabelle
       
       Zeile = Application.WoorksheetFunction.Match(T1, Sheets("Tabelle2").Range("A2:A373"), 0)
       
       r_l = Application.WoorksheetFunction.Index(Sheets("Tabelle2").Range("A2:P373"), Zeile, x) _


       
       r_k = Application.WoorksheetFunction.Index(Sheets("Tabelle2").Range("A2:P373"), Zeile, y) _


             
       ' Falls T_k = T_l dann keine Interpolation notwendig:
       If r_l = r_k Then
            
            MATCHING = r_l
            
            ' Ansonsten lineare Interpolation der beiden "nächsten" Zinssätzen:
            Else:
            
            lambda = (T2 - T_k) / (T_l - T_k)
                
            MATCHING = (1 - lambda) * r_k + lambda * r_l
       
       End If
       
       ' Implementierung des alternativen Siegel-Svensson-Modell wird noch eingebaut!
    
    End If
       
    End Function

  

Betrifft: AW: DRINGEND!!! Fehlermeldung #WERT! bei VBA_Funktion von: Luschi
Geschrieben am: 31.10.2014 20:55:33

Hallo Florian,

hier sind ein 2 kleine Fehler drin:
RLZ_year = Application.WooksheetFunction.YearFrac(T1, T2, 1) 'falsch
RLZ_year = Application.WorksheetFunction.YearFrac(T1, T2, 1) 'richtig

Dann benöigt die YearFrac-Funktion Datumswerte statt Double - also:
Function MATCHING(ByVal T1 As Date, ByVal T2 As Date) As Double

aus der vba-Online-Hilfe:
YEARFRAC(start_date, end_date, [basis])

The YEARFRAC function syntax has the following arguments:
Start_date Required. A date that represents the start date.
End_date Required. A date that represents the end date.
Basis Optional. The type of day count basis to use.

Dann mußt Du natürlich auch der MATCHING-Funktion Datumswerte übergeben.


Gruß von Luschi
aus klein-Paris


  

Betrifft: AW: DRINGEND!!! Fehlermeldung #WERT! bei VBA_Funktion von: Florian Müller
Geschrieben am: 01.11.2014 13:37:15

Danke für den Hinweis!
Ich habe das nun gemacht, und zudem einen weiteren Fehler, nämlich die Korrektur von T_l und T_k angepasst. Es handelt sich hierbei nämlich auch um zwei Datumsangaben: Bei T_l bzw. T_k werden jeweils eine bestimmte Anzahl an Wochen bzw. Monate auf T1 addiert.
Leider klappt es immer noch nicht mit dem Code :-(
Als weiteren Hinweis: bei Sheets("Tabelle2").Range("A2:P373") handelt es sich auch um Datumsangaben, die mit dem Datumswert von T1 abgeglichen werden sollen.

Hier der "neue" Code:

Function MATCHING(ByVal T1 As Date, _
                        ByVal T2 As Date) As Double
                        
                        
    
    
' Dimensionierung der Hilfsvariablen
        
        Dim x As Integer, _
            y As Integer, _
            i As Integer, _
            j As Integer, _
            T_l As Date, _
            T_k As Date, _
            r_l As Double, _
            r_k As Double, _
            Zeile As Double, _
            lambda As Double, _
            RLZ As Double, _
            RLZ_year As Double
        
    ' Restlaufzeit in Tagen
        RLZ = T2 - T1
    ' Restlaufzeit in Jahre
        RLZ_year = Application.WorksheetFunction.YearFrac(T1, T2, 1)
        
' Falls Restlaufzeit <= 1 Jahr Zuordnung zu laufzeitadäquatem EURIBOR:
    If RLZ_year <= 1 Then
        
        ' Prüfung, ob Laufzeit <= 3 Wochen
        If RLZ <= 21 Then
                
                For i = 1 To 3  ' Schleife für Woche 1 bis Woche 3
                    
                    If RLZ <= i * 7 Then
                        
                        x = i + 1
                        T_l = DateAdd("d", i * 7, T1)
                            
                        If RLZ <= 7 Then
                            
                            y = 2
                            T_k = DateAdd("d", 7, T1)
                            
                        ElseIf RLZ = i * 7 Then
                            y = x
                            T_k = T_l
                            
                        Else:
                            y = i
                            T_k = DateAdd("d", (i - 1) * 7, T1)
                                
                        End If
                    
                    Exit For
                                                                            
                    End If
                
                Next i
        
        ' Ansonsten: Bestimmung der Laufzeit zwischen 1 und 12 Monaten:
        Else:
        
                For j = 1 To 12 ' Schleife für einen Monat bis zwölf Monate
                    
                    If Application.WorksheetFunction.RoundUp(RLZ_year * 12, 0) = j Then
                        
                        x = j + 4
                        T_l = DateAdd("m", j, T1)
                        
                        If Application.WorksheetFunction.RoundDown(RLZ_year * 12, 0) = j Then
                            y = x
                            T_k = DateAdd("m", j, T1)
                            
                        Else:
                            y = j + 3
                            If y = 4 Then
                                T_k = DateAdd("d", 21, T1)
                                Else:
                                T_k = DateAdd("m", j - 1, T1)
                                End If
                        
                        End If
                        
                    Exit For
                    
                    End If
                
                Next j
                
       End If
       
       
       ' Ablesen der "nächstgelegenen" Zinssätze aus der EURIBOR-Tabelle
              
       Zeile = Application.WorksheetFunction.Match(T1, Sheets("Tabelle2").Range("A2:A373"), 0)
       
       r_l = Application.WorksheetFunction.Index(Sheets("Tabelle2").Range("A2:P373"), Zeile, x)
       
       r_k = Application.WorksheetFunction.Index(Sheets("Tabelle2").Range("A2:P373"), Zeile, y)
             
       ' Falls T_k = T_l, keine Interpolation notwendig:
       If r_l = r_k Then
            
            MATCHING = r_l
            
            ' Ansonsten lineare Interpolation der beiden "nächsten" Zinssätzen:
            Else:
            
            lambda = (T2 - T_k) / (T_l - T_k)
                
            MATCHING = (1 - lambda) * r_k + lambda * r_l
       
       End If
       
       ' Implementierung des alternativen Siegel-Svensson-Modell wird noch eingebaut!
    
    End If
       
    End Function



  

Betrifft: AW: DRINGEND!!! Fehlermeldung #WERT! bei VBA_Funktion von: Florian Müller
Geschrieben am: 01.11.2014 16:15:00

... Habe nun am Ende des Codes noch einige kleine Veränderungen vorgenommen. Ich hoffe, es kann mir jemand kurz helfen:

Function MATCHING(ByVal T1 As Date, _
                        ByVal T2 As Date) As Double
                        
                        
    
    
' Dimensionierung der Hilfsvariablen
        
        Dim x As Integer, _
            y As Integer, _
            i As Integer, _
            j As Integer, _
            T_l As Date, _
            T_k As Date, _
            r_l As Double, _
            r_k As Double, _
            Zeile As Double, _
            lambda As Double, _
            RLZ As Double, _
            RLZ_year As Double
            
        
    ' Restlaufzeit in Tagen
        RLZ = DateDiff("d", T1, T2)
    ' Restlaufzeit in Jahre
        RLZ_year = Application.WorksheetFunction.YearFrac(T1, T2, 1)
        
' Falls Restlaufzeit <= 1 Jahr Zuordnung zu laufzeitadäquatem EURIBOR:
    If RLZ_year <= 1 Then
        
        ' Prüfung, ob Laufzeit <= 3 Wochen
        If RLZ <= 21 Then
                
                For i = 1 To 3  ' Schleife für Woche 1 bis Woche 3
                    
                    If RLZ <= i * 7 Then
                        
                        x = i + 1
                        T_l = DateAdd("d", i * 7, T1)
                            
                        If RLZ <= 7 Then
                            
                            y = 2
                            T_k = DateAdd("d", 7, T1)
                            
                        ElseIf RLZ = i * 7 Then
                            y = x
                            T_k = T_l
                            
                        Else:
                            y = i
                            T_k = DateAdd("d", (i - 1) * 7, T1)
                                
                        End If
                    
                    Exit For
                                                                            
                    End If
                
                Next i
        
        ' Ansonsten: Bestimmung der Laufzeit zwischen 1 und 12 Monaten:
        Else:
        
                For j = 1 To 12 ' Schleife für einen Monat bis zwölf Monate
                    
                    If Application.WorksheetFunction.RoundUp(RLZ_year * 12, 0) = j Then
                        
                        x = j + 4
                        T_l = DateAdd("m", j, T1)
                        
                        If Application.WorksheetFunction.RoundDown(RLZ_year * 12, 0) = j Then
                            y = x
                            T_k = DateAdd("m", j, T1)
                            
                        Else:
                            y = j + 3
                            If y = 4 Then
                                T_k = DateAdd("d", 21, T1)
                                Else:
                                T_k = DateAdd("m", j - 1, T1)
                                End If
                        
                        End If
                        
                    Exit For
                    
                    End If
                
                Next j
              
         End If
       
    ' Ablesen der "nächstgelegenen" Zinssätze aus der EURIBOR-Tabelle
  
    Zeile = Application.WorksheetFunction.Match(T1, Sheets("Tabelle2").Range("A2:A373"), 0)
       
    r_l = Application.WorksheetFunction.Index(Sheets("Tabelle2").Range("A2:P373"), Zeile, x)
       
    r_k = Application.WorksheetFunction.Index(Sheets("Tabelle2").Range("A2:P373"), Zeile, y)
             
        ' Falls T_k = T_l keine Interpolation notwendig:
        If r_l = r_k Then
            
        MATCHING = r_l
            
        ' Ansonsten lineare Interpolation der beiden "nächsten" Zinssätzen:
            Else:
            
            lambda = DateDiff("yyyy", T_k, T2) / DateDiff("yyyy", T_k, T_l)
                
            MATCHING = (1 - lambda) * r_k + lambda * r_l
       
        End If
        
          
    ' Implementierung des alternativen Siegel-Svensson-Modell wird noch eingebaut!
    
    End If
       
    End Function



  

Betrifft: AW: DRINGEND!!! Fehlermeldung #WERT! bei VBA_Funktion von: Luschi
Geschrieben am: 02.11.2014 09:57:40

Hallo Florian,

hier noch eine kleine Änderung:
statt:
Zeile = Application.WorksheetFunction.Match(T1, Sheets("Tabelle2").Range("A2:A373"), 0)
so:
Zeile = Application.WorksheetFunction.Match(CLng(T1), Sheets("Tabelle2").Range("A2:A373"), 0)

Gruß von Luschi
aus klein-Paris


  

Betrifft: AW: DRINGEND!!! Fehlermeldung #WERT! bei VBA_Funktion von: Florian Müller
Geschrieben am: 03.11.2014 09:31:28

Vielen Dank für den Hinweis!
Es lag tatsächlich an der Anweisung "Zeile".
Ich habe es schließlich so gelöst, dass ich T1 als String-Variable T_1 definiert habe; so klappte es dann!

Vielen herzlichen Dank!


  

Betrifft: AW: DRINGEND!!! Fehlermeldung #WERT! bei VBA_Funktion von: Luschi
Geschrieben am: 03.11.2014 10:12:25

Hallo Florian,

das hier "Ich habe es schließlich so gelöst, dass ich T1 als String-Variable T_1 definiert habe; so klappte es dann!" - verstehe ich nicht. Du solltest doch in der Match-Funktion nur T1 gegen Clng(T1) ändern, also
Zeile = Application.WorksheetFunction.Match(Clng(T1), Sheets("Tabelle2").Range("A2:A373"), 0)

Zeige doch mal als Code, was Du gemacht hast!

Gruß von Luschi
aus klein-Paris


  

Betrifft: AW: DRINGEND!!! Fehlermeldung #WERT! bei VBA_Funktion von: Florian Müller
Geschrieben am: 05.11.2014 09:22:31

Hi,

ich habe quasi das Problem schon gelöst, ehe ich Deine Antwort gelesen habe!
So, wie ich es jetzt gemacht habe, funktioniert es jedenfalls:


Dim T_1 As String

T_1 = T1

Arr = Worksheets("EURIBOR").Range("A1:A373")

Zeile = Application.WorksheetFunction.Match(T_1, Arr, 0)

Mat = Worksheets("EURIBOR").Range("A1:P373")

r_l = Application.WorksheetFunction.Index(Mat, Zeile, X)

r_k = Application.WorksheetFunction.Index(Mat, Zeile, y)



 

Beiträge aus den Excel-Beispielen zum Thema "DRINGEND!!! Fehlermeldung #WERT! bei VBA_Funktion"