Excel VBA中DateSerial处理波斯历(Shamsi)日期异常求助

原代码核心错误有两点：

• DateSerial函数基于**公历（Gregorian）**设计，直接传入波斯历年份（如1402）会超出公历常规年份范围，计算出错误的公元前日期。
• 提前用Format将文本框内容转为波斯数字格式，后续转整数时会因波斯数字的Unicode编码问题，无法得到正确的1402、01、28数值。

要实现波斯历日期正确录入并以日期格式显示，需分两步操作：

1. 将输入的波斯历日期转换为Excel可识别的公历日期序列号（Excel内部用序列号存储日期）。
2. 设置目标单元格的数字格式为波斯历样式，让日期以波斯历格式展示。

修正后的代码 #

Dim intDay As Integer
Dim intMonth As Integer
Dim intYear As Integer
Dim rng1 As Range
Dim gregorianDate As Date

' 需先给rng1赋值，示例为当前活动单元格，可根据实际场景调整
Set rng1 = ActiveCell

If Me.TextBox43 <> "" Then
    ' 直接获取文本框的阿拉伯数字输入，避免转码错误
    intYear = Val(Me.TextBox43)
    intMonth = Val(Me.TextBox44)
    intDay = Val(Me.TextBox45)
    
    ' 用Excel内置函数将波斯历日期转为公历日期序列号
    gregorianDate = WorksheetFunction.PersianToGregorian(intYear, intMonth, intDay)
    
    ' 写入日期值并设置波斯历显示格式
    rng1.Offset(0, -2).Value = gregorianDate
    rng1.Offset(0, -2).NumberFormat = "[$-fa-IR,16]yyyy/mm/dd;@"
Else
    ' 空文本框时写入当前日期，同样设置波斯历显示格式
    rng1.Offset(0, -2).Value = Date
    rng1.Offset(0, -2).NumberFormat = "[$-fa-IR,16]yyyy/mm/dd;@"
End If

关键说明 #

• 数字输入处理：确保文本框输入阿拉伯数字（0-9），若需支持波斯数字（۰-۹）输入，可添加转换函数。
• 历法转换：WorksheetFunction.PersianToGregorian是Excel内置的精准转换函数，能避免手动计算误差。
• 格式设置：通过NumberFormat设置显示格式，单元格存储的是真实日期值（可用于日期计算），仅展示为波斯历样式。

波斯数字输入兼容补充（可选） #

如果用户习惯输入波斯数字，可添加以下转换函数：

Function PersianToArabic(str As String) As String
    Dim i As Integer
    Dim char As String
    For i = 1 To Len(str)
        char = Mid(str, i, 1)
        Select Case char
            Case "۰": char = "0"
            Case "۱": char = "1"
            Case "۲": char = "2"
            Case "۳": char = "3"
            Case "۴": char = "4"
            Case "۵": char = "5"
            Case "۶": char = "6"
            Case "۷": char = "7"
            Case "۸": char = "8"
            Case "۹": char = "9"
        End Select
        PersianToArabic = PersianToArabic & char
    Next i
End Function

使用时修改数值获取代码：

intYear = Val(PersianToArabic(Me.TextBox43))
intMonth = Val(PersianToArabic(Me.TextBox44))
intDay = Val(PersianToArabic(Me.TextBox45))

内容的提问来源于stack exchange，提问作者Hooman Hasanzadeh