Ich habe da ein seltsames Problem. Meine Funktion läuft wunderbar im Direktfenster, aber bei identischem Aufruf ('Umrechnung("VJ"; AE"; "EUR"; 3)' aus Excel heraus bekomme ich einen #WERT!-Fehler.
Kurzbeschreibung:
Datenreihe (bspw. AE) in Array einlesen [Auflaufwerte], Monatswerte errechnen und mittels Mischkursen (ebenfalls Array) monatsweise auf andere Währung konvertieren, anschließend summieren und Ergebnis ausgeben.
"VJ" ist die Tabelle mit der Datenreihe, "AE" das umrzurechnende Objekt aus der Tabelle, "EUR" die Zielwährung und "3" die Anzahl der lfd. Monate.
Was habe ich übersehen?
Danke für jeglichen Tip!
Nachmittäglichen Gruß
Ralph
--
Dim Fehlermeldung As String
Dim i As Single
Dim Perfcardwert(1 To 12), PerfcardwertFX(1 To 12), Monatseinzelwert(1 To 12), Mischkurs(1 To 12)
Public Function Umrechnung(Tabelle, Umrobjekt, Kurs, aktMonat)
' On Error GoTo Fehler:
Set Kursblatt = Workbooks("PerfCard.xls").Worksheets("Mischkurse") 'Referenz auf Mischkursblatt
Set Datenblatt = Workbooks("PerfCard.xls").Worksheets(Tabelle) 'Referenz auf Datenblatt
'Debug.Print Tabelle, Umrobjekt, Kurs, aktMonat
'
'Variablen & Arrays initialisieren
'
For i = 1 To 12
Fehlermeldung = "Okay" 'Änderung nur bei Fehler in Ablauf
Mischkurs(i) = 0 'Umrechnungskurs(e)
Perfcardwert(i) = 0 'PerfCard-Werte in Landeswährung (Auflauf)
Monatseinzelwert(i) = 0 'PerfCard-Werte in Landeswährung (Monatseinzel)
PerfcardwertFX(i) = 0 'umgerechnete Monatseinzelwerte
Next i
'
' Mischkurse einlesen
'
Kursblatt.Activate
For i = 1 To aktMonat
Kursblatt.Range("A:A").Find(Kurs).Activate 'Erste Zelle in Mischkurszeile aktivieren
Set Monatskurs = ActiveCell.Offset(0, i + 1) 'Erster Mischkurs-Wert in Spalte 3
Mischkurs(i) = Monatskurs.Value 'Mischkurs-Array füllen
If Mischkurs(i) = 0 Then Fehlermeldung = "Mischkurs fehlt"
'
Debug.Print "Mischkurs: "; i; Mischkurs(i)
Next i
Debug.Print 'Zeilenumbruch
'
' Daten in Landeswährung einlesen
'
Datenblatt.Activate
For i = 1 To aktMonat
Datenblatt.Range("A:A").Find(Umrobjekt).Activate 'Erste Zelle in Datenzeile aktivieren
Set Monatswert = ActiveCell.Offset(0, i + 1) 'Erster Datenwert in Spalte 3
Perfcardwert(i) = Monatswert.Value 'Datenarray füllen (-> Auflaufwerte <-)
If i > 1 Then '1. Datenwert kann leer sein - kein Fehler
If Perfcardwert(i) = 0 Then Fehlermeldung = "Quelldaten fehlen"
End If
'Debug.Print i; Perfcardwert(i)
Next i
'
'Monatseinzelwerte errechnen
'
For i = 1 To aktMonat
Select Case i
Case 1
If Perfcardwert(1) = 0 Then 'Oktoberwert leer...
Monatseinzelwert(1) = Perfcardwert(2) / 2 '...dann halber Novemberwert
Else 'Oktoberwert vorhanden...
Monatseinzelwert(1) = Perfcardwert(1) '... daher normale Zuweisung
End If
Case 2
If Perfcardwert(1) = 0 Then 'Kein Oktoberwert...
Monatseinzelwert(i) = Perfcardwert(2) / 2 '... dann halber Novemberwert
Else
Monatseinzelwert(i) = Perfcardwert(i) - Perfcardwert(i - 1) 'sonst normale Zuweisung
End If
Case 3 To 12
Monatseinzelwert(i) = Perfcardwert(i) - Perfcardwert(i - 1) 'Auflaufwert ./. Vormonat
Case Else
Fehlermeldung = "Sonstiger Fehler" ' Fehler - keine Zuweisung
End Select
Debug.Print i; "Monatseinzelwert"; Monatseinzelwert(i); "Perfcardwert"; Perfcardwert(i)
Next i
'
'Landeswährung umrechnen auf gewählte Darstellung
'
For i = 1 To aktMonat
PerfcardwertFX(i) = Monatseinzelwert(i) * Mischkurs(i)
Debug.Print "PerfcardwertFX("; i; "): "; PerfcardwertFX(i)
Next i
'
'Summe bilden
'
Perfcardsumme = 0 'Ergebnbisvariable löschen
For i = 1 To aktMonat
Perfcardsumme = Perfcardsumme + PerfcardwertFX(i) 'Einzelwerte aufsummieren
Debug.Print "Perfcardsumme ("; i; "): "; Perfcardsumme
Next i
'
'Rückmeldung der Funktion
'
Select Case Fehlermeldung
Case "Okay"
Umrechnung = CSng(Perfcardsumme) 'Funktion gibt umgerechnete Summe zurück
Exit Function 'und wird beendet
Case Else
GoTo Fehler 'Verzweigung zur Fehlerroutine
End Select
Fehler:
If Err.Number = 0 Then
Umrechnung = CStr(Fehlermeldung) 'Fehlermeldung aus Prozedur
Else
Umrechnung = Err.Number 'Excel-Fehlermeldung
End If
End Function