محاسبه چند ماه بعد از یک تاریخ مشخص شمسی در اکسل
فرض کنید می خواهیم تاریخ چند ماه بعد از یک تاریخ مشخص را در اکسل محاسبه کنیم یا به عبارت دیگر می خواهیم بدانیم مثلا 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
همچنین می توانید نمونه ای از فایل اکسل که این تابع در آن پیاده سازی شده است را از لیک زیر دریافت نمایید.
نویسنده: جلیل آرین یگانه
نظرات
احمد
1394/05/10خیلی ممنون- ولی بعد اینکه من فایل مورد نظرم را save میکنم و مجددا میخواهم وارد بشم و مطالب یا تغییراتی در تاریخ بدم پیغامname را صادر میکند -لطفا راهنمائی کنید
مهدی
1394/07/10ممنون عالی بود. دمت گرم
نسیم
1394/10/18باسلام و خسته نباشید .
میخواستم کمکم کنید که دراکسل تاریخ مورد نظر رسید یا آلارم بدهد یا رنگی شود .
باتشکر.
فریناز
1396/09/11خوب بود ، ممنون
میخواستم کمکم کنید که دراکسل تاریخ مورد نظر رسید یا آلارم بدهد یا رنگی شود . مثلا بعد از 15 روز از یک تاریخ مشخص میخوام که آلارم بده یا رنگی شود
باتشکر
سمیرا
1395/01/17سلام ممنون خیلی خوب بود فقط اگه به طور مثال بخوایم بدونیم 130 روز آینده چه تاریخی میشه ، راهی داره ؟
شئهق
1395/02/30ENABEL VBA را اتخاب کنید تا هنکام سیو VBA بر روی فایل باقی بماند
mohsen
1395/06/26سلام میخواستم بدونم در اکسل تاریخ بدیم خودش روز را بدهد
ممنون میشم کمکم کنید
دیاکو احمدپور
1396/04/10سلام . نمیدونم به چه زبونی ازتون تشکر کنم . امیدوارم تو زندگیتون همیشه سالم و شاد باشید . این فایل خیلی کار منو راه انداخت.واقعا دمتون گرم.سایت شما رفت تو علاقه مندیهام.امیدوارم یک روزی بتونم جبران کنم.قربان دستتان
Navid
1396/09/01آقا دمت گرم خیلی کارم جلو افتاد .
اکبر
1396/11/10باسلام وخسته نباشید .لطفا نحوه ذخیره راهم توضیح دهید .چون وقتی فرمول راکپی میکنم وعملیات روی ان انجام میدم ذخیره نمیشه وبعد از کلوز کردن وباز کردن مجدد اصلا خبری از دستورات فرمول نیست وبه حالت عادی اکسل برمیگردد اگر راهنمایی کنید ممنون میشم.
وحید هادی
1397/09/16باسلام و احترام
لطفا در مورد کاهش چند ماه از یک تاریخ شمسی رو هم راهنمایی بفرمائید .
ممنون
امیر حسین چیذری
1399/08/05عالی بود ممنونم
نام (ضروری) |
پست الکترونیک(ضروری) |
نظرشمــا |
ارسال نظر |