[حل شده] درج تاریخ در سلول بصورت ثابت ( فقط ماه و سال تغییر کند)

[a.dal65]

دوستان من یه سلول دارم که توش تاریخ وارد میکنم (مثلا 1393/01/01)
میخوام توی جدولی عدد روز ثابت باشه و فقط ماه و سال به ترتیب تغییر کنه (به این صورت

1393/02/01
1393/03/01
1393/04/01
1393/05/01
1393/06/01
1393/07/01
1393/08/01
1393/09/01
1393/10/01
1393/11/01
1393/12/01
1394/01/01
1394/02/01
1394/03/01
1394/04/01
1394/05/01
و .....


با کلی If نوشتم و درست کار میکنه تا جای که در بعضی سال ها ماه های اسفند 30 روزه هست و باز تاریخ ها بعد اون به هم میریزه.
ممنون میشم راهی ساده تر و بدون خطا معرفی کنید بهم

[iranweld]

با سلام

از فرمول ذیل استفاده کنید و در جاییکه بعد از اولین تاریخ کبیسه عدد روز فرق میکنه اون سلول را از حالت فرمول خارج نموده و تاریخ مورد نظر رو دستی وارد کنید

در فایل پیوست بصورت رنگ زرد مشخص شده است

=if(value(mid(a7,6,2))<7,j_addday(a7,31,1),if(value(mid(a7,6,2))=12,j_addday(a7,29,1),j_addday(a7,30,1))) 

[a.dal65]

ممنون جناب iranweld

مشکل فایل من همین سال های کبیسه هستش


راهی نداره که دستی وارد نکنم . (به هر روشی)
هدف من فقط اینکه همه به ترتیب باشن.

[a.dal65]

اگه تاریخ رو 1393/01/31 وارد بشه از 6 ماه اول سال به بعد اشتباه میشه

[Amir Ghasemiyan]

سلام دوست عزيز

چند حالت رو تست كردم اما خب شايد تست هاي جامعي نباشه. اين تابع رو تست كنيد ببينيد مشكلتون حل ميشه يا نه addMonth

Function addMonth(d As String)
Dim dateArr
dateArr = Split(d, "/")
thisYear = CInt(dateArr(0))
thisMonth = CInt(dateArr(1))
thisDay = CInt(dateArr(2))

thisMonth = thisMonth + 1
If thisMonth > 12 Then
    thisYear = thisYear + 1
    thisMonth = 1
End If
If thisMonth > 6 And thisDay > 30 Then thisDay = 30
assad = EI_isLeap(thisYear)
If thisMonth = 12 And thisDay >= 30 And Not EI_isLeap(thisYear) Then thisDay = 29

addMonth = FullDate(thisYear, thisMonth, thisDay)

End Function

Function FullDate(Y, M, d)
Dim Y1 As String, M1 As String, D1 As String
Y1 = Y: M1 = M: D1 = d
If Len(M) < 2 Then M1 = 0 & M
If Len(d) < 2 Then D1 = 0 & d
FullDate = Y1 & "/" & M1 & "/" & D1
End Function


Function EI_isLeap(ByVal TheYear As String, Optional Mode As Boolean = False, Optional Calendar_Type As String = "J")
If InStrRev(TheYear, "/") Or InStrRev(TheYear, "-") Or InStrRev(TheYear, " ") Then TheYear = Year_of_Date(TheYear, Mode, Calendar_Type)
If TheYear < 1 Then EI_isLeap = CVErr(xlErrNA): Exit Function
If Calendar_Type = "J" Or Calendar_Type = "j" Then
    If TheYear <= 473 Then
        Select Case Val(TheYear) Mod 128
            Case 0, 4, 8, 12, 16, 20, 25, 29, 33, 37, 41, 45, 49, 53, 58, 62, 66, 70, 74, 78, 82, 86, 91, 95, 99, 103, 107, 111, 115, 120, 124
                EI_isLeap = True
            Case Else
                EI_isLeap = False
        End Select
    Else
        Select Case Val(TheYear) Mod 128
            Case 0, 4, 8, 12, 16, 20, 24, 29, 33, 37, 41, 45, 49, 53, 57, 62, 66, 70, 74, 78, 82, 86, 90, 95, 99, 103, 107, 111, 115, 119, 124
                EI_isLeap = True
            Case Else
                EI_isLeap = False
        End Select
    End If
ElseIf Calendar_Type = "G" Or Calendar_Type = "g" Then
    If Val(TheYear) Mod 400 = 0 Or (Val(TheYear) Mod 4 = 0 And Val(TheYear) Mod 100 <> 0) Then
        EI_isLeap = True
    Else
         EI_isLeap = False
    End If
Else
    EI_isLeap = CVErr(xlErrNA)
    Exit Function
End If

End Function

Function Year_of_Date(ByVal this_date As String, Optional Mode = False, Optional Calendar_Type As String = "J")
this_date_arr = separate_date(this_date)
Dim Y As Integer
Y = this_date_arr(0)
If UBound(this_date_arr) <> 2 Then
    this_date1 = Format(this_date_arr(0), "yy/mm/dd"): this_date1 = Split(this_date_arr, "/")
    this_date2 = Format(this_date_arr(0), "yyyy/mm/dd"): this_date2 = Split(this_date_arr, "/")
    If UBound(this_date1) <> 2 Then Year_of_Date = CVErr(xlErrValue): Exit Function
End If

If Not Mode Then this_date_arr(0) = YYYY(Y, Calendar_Type)
    
Year_of_Date = this_date_arr(0)
End Function

[a.dal65]

ممنون امیر جان بسیـــــــــــــــــــــــــــــــــــــــــــــــ ـــــار عــــالــــــــــــــــــی