محاسبه چند ماه بعد از یک تاریخ مشخص شمسی در اکسل

17,144 بازدید

فرض کنید می خواهیم تاریخ چند ماه بعد از یک تاریخ مشخص را در اکسل محاسبه کنیم یا به عبارت دیگر می خواهیم بدانیم مثلا 10، 15 یا 21 ماه بعد از یک تاریخ مشخص برابر با چه تاریخی می شود. برای این منظور می توانیم از تابع زیر استفاد کنیم. توجه کنید از آنجا که در نیمه دوم هر سال ماه ها 30 روزه و ماه اسفند در بیشتر موارد 29 روزه است بنابراین چنانچه تاریخ مبدا در نیمه اول سال و تاریخ محاسبه شده در نیمه دوم سال باشد در حالی که روز تاریخ مبدا برابر با 31 باشد روز تاریخ محاسبه شده 29 یا 30 خواهد بود به عنوان مثال یک ماه بعد از تاریخ 1393/06/31 برابر 1393/07/30 خواهد بود. در چند سطر زیر به توضیح مختصری از کارکرد هر کدام از توابع می پردازم:

تابع AddMonth:
این تابع به یک تاریخ مشخص شمسی تعدادی ماه می افزاید و دو پارامتر ورودی دارد که پارامتر اول تاریخ مبدا با فرمت "1394/04/13" و پارامتر دوم تعداد ماه هایی است که مایلیم به تاریخ مبدا بیافزاییم.

تابع IsValidShDate:
این تابع مشخص می نماید که آیا یک تاریخ شمسی معتبر می باشد یا خیر. بعنوان مثال تاریخ "1361/01/01" یک تاریخ معتبر اما "1361/13/01" یا "1361/07/31" تاریخ هایی نامعتبر هستند.

تابع JLeap:
مشخص می نماید که آیا یک سال شمسی کبیسه می باشد یا خیر.

تابع ShMonthDayCount:
تعداد روزهای یک ماه را محاسبه می نماید.

برای استفاده از این تابع، ابتدا یک فایل اکسل باز نموده و با فشردن کلیدهای Alt+F11 به قسمت ویرایش گر VBA آن وارد شوید. سپس از منوی سمت چپ بر روی نام پروژه خود راست کلیک نموده و یک ماژول به پروژه خود بیافزایید. سپس تمامی توابع زیر را کپی و در قسمت سمت راست ویرایشگر بچسبانید. شکل زیر نمایی از ویرایشگر VBA را نمایش می دهد.

تاریخ شمسی اکسل

بعد از آن ویرایشگر VBA را بسته و به محیط اکسل بازگردید. اکنون در یکی از سلول های اکسل تاریخ مبدا (مثلا 1361/01/01) را وارد نموده و در سلولی دیگر برای محاسبه یک ماه بعد از آن فرمول AddMonth را با پارامترهای مورد نظر بنویسید. شکل زیر نمایی از این عمل را نشان می دهد.

تاریخ شمسی اکسل

' AddMonth Excel Function
' Copyright 1393, Jalil Aryan Yegane
' http://www.papyrus.ir/Pages/3364
Function AddMonth(sDate As String, iMonth) As String
    Dim WrdArray() As String
    Dim y, m, d As Integer
    Dim sm, sd As String
    WrdArray() = Split(sDate, "/")
    y = 0
    m = 0
    d = 0
    If UBound(WrdArray()) + 1 = 3 Then
        y = Cint(WrdArray(0))
        m = Cint(WrdArray(1))
        d = Cint(WrdArray(2))
        If y < 100 Then
            y = 1300 + y
        End If
        If IsValidShDate(y, m, d) Then
            isLeapYear = Jleap(y)
            For i = 1 To iMonth
                m = m + 1
                If m > 12 Then
                    m = 1
                    y = y + 1
                End If
            Next
            If d = 31 And (m > 6 And m <= 12) Then
                d = 30
            End If
            If d = 30 And m = 12 And isLeapYear = False Then
                d = 29
            End If
            If d = 30 And m = 12 And isLeapYear Then
                d = 30
            End If
            If m < 10 Then
                sm = "0" & m
            Else
                sm = m
            End If
            If d < 10 Then
                sd = "0" & d
            Else
                sd = d
            End If
            AddMonth = y & "/" & sm & "/" & sd
        Else
            AddMonth = "تاریخ ورودی نامعتبر"
        End If
    Else
        AddMonth = "فرمت تاریخ ورودی نامعتبر"
    End If
End Function
Function IsValidShDate(ByVal y As Integer, ByVal m As Integer, ByVal d As Integer) As Boolean
    If (y >= 1 And m >= 1 And m <= 12 And d >= 1 And d <= ShMonthDayCount(y, m)) Then
        IsValidShDate = True
    Else
        IsValidShDate = False
    End If
End Function
Function Jleap(ByVal Year As Integer) As Boolean
    Dim tmp As Integer
    tmp = Year Mod 33
    If (tmp = 1 Or tmp = 5 Or tmp = 9 Or tmp = 13 Or tmp = 17 Or tmp = 22 Or tmp = 26 Or tmp = 30) Then
        Jleap = True
    Else
        Jleap = False
    End If
End Function
Function ShMonthDayCount(ByVal y As Integer, ByVal m As Integer) As Integer
    Dim result As Integer
        If m <= 6 Then
            result = 31
        Else
            If m <= 11 Then
                result = 30
            Else
                If Jleap(y) Then
                    result = 30
                Else
                    result = 29
                End If
            End If
        End If
    ShMonthDayCount = result
End Function

همچنین می توانید نمونه ای از فایل اکسل که این تابع در آن پیاده سازی شده است را از لیک زیر دریافت نمایید.
نویسنده: جلیل آرین یگانه

0 صفحه   |   حجم فایل: 16 KB   |   فرمت: Zip

نظرات

احمد
1394/05/10
پاسخ به این نظر

خیلی ممنون- ولی بعد اینکه من فایل مورد نظرم را save میکنم و مجددا میخواهم وارد بشم و مطالب یا تغییراتی در تاریخ بدم پیغامname را صادر میکند -لطفا راهنمائی کنید

مهدی
1394/07/10
پاسخ به این نظر

ممنون عالی بود. دمت گرم

نسیم
1394/10/18
پاسخ به این نظر

باسلام و خسته نباشید .
میخواستم کمکم کنید که دراکسل تاریخ مورد نظر رسید یا آلارم بدهد یا رنگی شود . باتشکر.

فریناز
1396/09/11

خوب بود ، ممنون
میخواستم کمکم کنید که دراکسل تاریخ مورد نظر رسید یا آلارم بدهد یا رنگی شود . مثلا بعد از 15 روز از یک تاریخ مشخص میخوام که آلارم بده یا رنگی شود
باتشکر

سمیرا
1395/01/17
پاسخ به این نظر

سلام ممنون خیلی خوب بود فقط اگه به طور مثال بخوایم بدونیم 130 روز آینده چه تاریخی میشه ، راهی داره ؟

شئهق
1395/02/30
پاسخ به این نظر

ENABEL VBA را اتخاب کنید تا هنکام سیو VBA بر روی فایل باقی بماند

mohsen
1395/06/26
پاسخ به این نظر

سلام میخواستم بدونم در اکسل تاریخ بدیم خودش روز را بدهد

ممنون میشم کمکم کنید

دیاکو احمدپور
1396/04/10
پاسخ به این نظر

سلام . نمیدونم به چه زبونی ازتون تشکر کنم . امیدوارم تو زندگیتون همیشه سالم و شاد باشید . این فایل خیلی کار منو راه انداخت.واقعا دمتون گرم.سایت شما رفت تو علاقه مندیهام.امیدوارم یک روزی بتونم جبران کنم.قربان دستتان

Navid
1396/09/01
پاسخ به این نظر

آقا دمت گرم خیلی کارم جلو افتاد .

اکبر
1396/11/10
پاسخ به این نظر

باسلام وخسته نباشید .لطفا نحوه ذخیره راهم توضیح دهید .چون وقتی فرمول راکپی میکنم وعملیات روی ان انجام میدم ذخیره نمیشه وبعد از کلوز کردن وباز کردن مجدد اصلا خبری از دستورات فرمول نیست وبه حالت عادی اکسل برمیگردد اگر راهنمایی کنید ممنون میشم.

وحید هادی
1397/09/16
پاسخ به این نظر

باسلام و احترام
لطفا در مورد کاهش چند ماه از یک تاریخ شمسی رو هم راهنمایی بفرمائید . ممنون

نام (ضروری)
پست الکترونیک(ضروری)
نظرشمــا
ارسال نظر
3364 Z
پی دی اف وان