Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA oder Formel - Konvert greg. in pers. Kalender

VBA oder Formel - Konvert greg. in pers. Kalender
05.10.2012 17:05:32
Alex
Hallo Leute,
ich habe das Problem, dass ich Datum(s)? ;-) gregorianisch in persisch wandeln muss.
Kennt jemand von euch vllt. eine Formel?
Oder lässt sich das in vba lösen?
Ich habe schon viel gesucht (google), das meiste war in Englisch und nur schwer nachzuvollziehen. Bin auch nicht so der VBA Crack. Ich habe einen Code gefunden, weiß aber nicht wie ich die Funktionen aufrufen soll.
Kann mir jemand helfen:
- mit einer Formellösung
- einem eigenen VBA Code
oder den von mir gefundenen zu verstehen und einzusetzen?
Option Explicit
Const Jofst As Double = 2415018.5
Function Civil2Persian(dat As Date) As Variant
' Converts a Civil (Gregorian) date
' to a Variant containing Persian year, month, and day
' E.g., Civil2Persian(DATE(2007, 12, 1)) = {1386, 9, 10}
' N.B.: Must be entered as an array formula
Civil2Persian = Julian2Persian(Civil2Julian(dat))
End Function
Function Persian2Civil(iYear As Integer, iMonth As Integer, iDay As Integer) As Date
' Converts a Persian year, month, and day to a Civil (Gregorian) date
' E.g., Persian2Civil(1386, 9, 10) = 39417 = 2007 Dec 01
Persian2Civil = Int(Julian2Civil(Persian2Julian(iYear, iMonth, iDay)))
End Function
Function PersianString2Civil(s As String) As Date
' Converts a string containing Persian year, month, and day
' to a Civil (Gregorian) date
' E.g., Persian2Civil("1386, 9, 10") = 39417 = 2007 Dec 01
Dim astr() As String
astr = Split(s, ",")
PersianString2Civil = Persian2Civil(CInt(astr(0)), CInt(astr(1)), CInt(astr(2)))
End Function
Function Civil2Julian(dat As Date) As Double
Civil2Julian = dat + Jofst
End Function
Function Julian2Civil(jdn As Long) As Date
Julian2Civil = jdn - Jofst
End Function
Function Persian2Julian(iYear As Integer, _
iMonth As Integer, _
iDay As Integer) As Long
Const PERSIAN_EPOCH = 1948321 ' The Julian of 1 Farvardin 1
Dim epbase As Long
Dim epyear As Long
Dim mdays As Long
If iYear >= 0 Then
epbase = iYear - 474
Else
epbase = iYear - 473
End If
epyear = 474 + (epbase Mod 2820)
If iMonth mdays = (CLng(iMonth) - 1) * 31
Else
mdays = (CLng(iMonth) - 1) * 30 + 6
End If
Persian2Julian = CLng(iDay) _
+ mdays _
+ Fix(((epyear * 682) - 110) / 2816) _
+ (epyear - 1) * 365 _
+ Fix(epbase / 2820) * 1029983 _
+ (PERSIAN_EPOCH - 1)
End Function
Function Julian2Persian(jdn As Long) As Variant
Dim depoch
Dim cycle
Dim cyear
Dim ycycle
Dim aux1, aux2
Dim yday
Dim iYear As Integer
Dim iMonth As Integer
Dim iDay As Integer
depoch = jdn - Persian2Julian(475, 1, 1)
cycle = Fix(depoch / 1029983)
cyear = depoch Mod 1029983
If cyear = 1029982 Then
ycycle = 2820
Else
aux1 = Fix(cyear / 366)
aux2 = cyear Mod 366
ycycle = Int(((2134 * aux1) + (2816 * aux2) + 2815) / 1028522) + aux1 + 1
End If
iYear = ycycle + (2820 * cycle) + 474
If iYear iYear = iYear - 1
End If
yday = (jdn - Persian2Julian(iYear, 1, 1)) + 1
If yday iMonth = Ceil(yday / 31)
Else
iMonth = Ceil((yday - 6) / 30)
End If
iDay = (jdn - Persian2Julian(iYear, iMonth, 1)) + 1
Julian2Persian = Array(iYear, iMonth, iDay)
End Function
' We needed an alternative to Int and Fix
' Int(8.4) = 8, Int(-8.4) = -9
' Fix(8.4) = 8, Fix(-8.4) = -8
' Ceil(8.4) = 9, Ceil(-8.4) = -9 Private Function Ceil(number As Single) As Long Ceil = -Sgn(number) * Int(-Abs(number)) End Function Vielen Dank
und Grüße aus Kunduz
Alex

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA oder Formel - Konvert greg. in pers. Kalender
05.10.2012 18:38:43
Jack
Hallo Alex
Du hast verschiedene "Programme " reinkopiert
Also wenn ich das richtig deute, greifen die alle ineinander
Im Zweifel einfach den ganzen "Kram" in ein Modul kopieren
und dann in der Exel-Tabelle die Funktion aufrufen
=Civil2Persian(DATE(2007, 12, 1))
und dann als Array formel abschliessen
Grüße

AW: VBA oder Formel - Konvert greg. in pers. Kalender
05.10.2012 20:47:44
Alex
Hi Jack,
vielen Dank für deine Antwort.
Ich habe alles so gemacht wie ihr (Erich und Du) es mir gesagt habt.
Jedoch gibt die Arrayformel Name? zurück.
Ich habe auch in der Formelbibliothek keine derartige Funktion (Civil2Persian) gefunden.
Liegt das an meinem Excel? Ich habe -wie angegeben- Office 2007.
Danke noch mal und Gruß
Alex

Anzeige
Matrixformel Persischer Kalender
05.10.2012 19:37:45
Erich
Hi Alex,
den Aufruf kannst du auf verschiedene Weisen in die Tabelle schreiben:
 ABCD
301.12.20071386910
401.12.20071386910

Formeln der Tabelle
ZelleFormel
B3{=Civil2Persian(A3)}
C3{=Civil2Persian(A3)}
D3{=Civil2Persian(A3)}
B4=INDEX(Civil2Persian($A3); SPALTE(A1))
C4=INDEX(Civil2Persian($A3); SPALTE(B1))
D4=INDEX(Civil2Persian($A3); SPALTE(C1))
Enthält Matrixformel:
Umrandende
{ } nicht miteingeben,
sondern Formel mit STRG+SHIFT+RETURN abschließen!
Matrix verstehen


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
In Zeile 3 musst du vor Eingabe der Formel die 3 Zellen B3:D3 markieren,
dann nach F2 die Formel eintippen (besser kopieren) und dann als Matrixformel abschließen.
In Zeile 4 kannst du die Formel in B4 als "normale" Formel eingeben und dann nach rechts auf C4 und D4 kopieren.
Man muss wissen, dass die Fkt. drei Werte zurückgibt - aber das war ja schon klar.
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
mit Rückrichtung
05.10.2012 19:52:17
Erich
Hi Alex,
die Rückrichtung (pers. zu greg.) in E3 ist einfacher - hat ja auch nur 1 Zahl als Ergebnis:
 ABCDE
2greg.persischgreg.
301.12.2007138691001.12.2007
401.12.20071386910 

Formeln der Tabelle
ZelleFormel
B3{=Civil2Persian(A3)}
C3{=Civil2Persian(A3)}
D3{=Civil2Persian(A3)}
E3=Persian2Civil(B3;C3;D3)
B4=INDEX(Civil2Persian($A3); SPALTE(A1))
C4=INDEX(Civil2Persian($A3); SPALTE(B1))
D4=INDEX(Civil2Persian($A3); SPALTE(C1))
Enthält Matrixformel:
Umrandende
{ } nicht miteingeben,
sondern Formel mit STRG+SHIFT+RETURN abschließen!
Matrix verstehen

Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
AW: mit Rückrichtung
05.10.2012 20:52:42
Alex
Hallo Erich,
vielen Dank für deine Antwort...
Ebenso wie ich schon Jack geantwortet habe:
Ich habe alles gemacht wie ihr sagtet (Arrayformeleingabe beachtet), jedoch gibt die Formel Name? zurück.
Habe in meiner Formelbibliothek auch keine Funktion Civil2Persian gefunden.
Liegt das vllt. an meinem Excel? Ich habe -wie angegeben- Office 2007.
Vielen Dank nochmal und Grüße
Alex

Wirklich alles? Wenn du die Fkt im ...
05.10.2012 21:20:55
Luc:-?
…FmlAssi nicht findest, Alex,
hast du sie auch nicht in ein allgemeines Modul eingefügt, sondern wahrscheinl in eines der Dokument-Klassenmodule, die standardmäßig immer vorhanden sind (1 pro Blatt und 1 extra für die Mappe). Unter Einfügen im VBE musst du Modul einfügen wählen.
Die AWer gingen wohl davon aus, dass du das bereits getan hast, denn auch beim von dir angegebenen Level könnte man das wissen – der Recorder macht das nämlich auch so.
Gruß Luc :-?
Anzeige

314 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige