پرسش اصلاح تاریخ های وارد شده

[9195597757]

در بانک اطلاعات تاریخ هایی از قبل وارد شده بود که حالا برای بهره برداری از آنها در فایل پیوست بدلیل نداشتن روز (تاریخ ها ماه و سال می باشد ) دچار مشکل شده ام راه حلی وجود دارد تا همه تاریخ ها دارای روز شوند مثلا تاریخی که 98/05 می باشد بشود 98/05/01 ( روز یکم به همه تاریخ ها اضافه شود )چون وارد نمودن اطلاعات بصورت دستی هم وقت گیر است و احتمال اشتباه زیاد دارد
با تشکر

[iranweld]

با سلام

شیت شما دارای پسورد میباشد و تغییرات توسط ماکرو قابل انجام نیست ابتدا شیت خودرا unprotected کنید
و از ماکرو ذیل استفاده کنید

Sub test()

For Each cell In ActiveSheet.UsedRange

xx = InStr(1, cell, "/")

If Len(cell) = 7 And xx = 5 Then

cell = cell & "/01"

End If

Next

End Sub 

[9195597757]

در sheet بانک اطلاعات می خواستم همه تارریخ ها اصلاح شود که پسورد ندارد

[9195597757]

در sheet بانک اطلاعات می خواستم همه تارریخ ها اصلاح شود که پسورد ندارد فایل ضمیمه sheet 2 هم بدو پسورد شده

[iranweld]

با سلام

بر روی باتن موجود در شیت دو کلیک کنید تا ماکرو تاریخ ها را اصلاح نماید

Sub test1()

r1 = Cells(Rows.Count, "A").End(xlUp).Row

For j = 1 To 25

For i = 1 To r1


xx = InStr(1, Cells(i, j), "/")


If Len(Cells(i, j)) = 6 And xx = 5 Then

Cells(i, j).Select

Cells(i, j).NumberFormat = "@"

sal = Left(Cells(i, j), 4)

mah = Right(Cells(i, j), 1)

Cells(i, j) = sal & "/0" & mah & "/01"


ElseIf Len(Cells(i, j)) = 7 And xx = 5 Then

Cells(i, j).NumberFormat = "@"

Cells(i, j) = Cells(i, j) & "/01"

End If

Next

Next



End Sub 

[M_ExceL]

ضمن تشکر از جناب iranweld این رو هم امتحان کنید، در کسری از ثانیه انجام میشه :

Sub test()
Dim c, r As Long
Dim ln As Byte
Dim rng As Range
Dim myar As Variant
Set rng = Range("d2:as1061")
myar = rng.Value
    Application.ScreenUpdating = False
        For c = 1 To 42
            For r = 1 To 1060
                If Mid(myar(r, c), 6, 1) <> "/" And InStr(1, myar(r, c), "/", 1) Then
                    ln = Len(myar(r, c))
                        Select Case ln
                            Case 6: myar(r, c) = Mid(myar(r, c), 1, 5) & "0" & Mid(myar(r, c), 6, 1) & "/01"
                            Case 7: myar(r, c) = myar(r, c) & "/01"
                            Case 8: myar(r, c) = Mid(myar(r, c), 3, 5) & "0" & Mid(myar(r, c), 8, 1) & "/01"
                            Case 9: myar(r, c) = Mid(myar(r, c), 1, 5) & "0" & Mid(myar(r, c), 6, 1) & "/01"
                            Case 10: myar(r, c) = Mid(myar(r, c), 1, 7) & "/01"
                        End Select
                End If
            Next
        Next
    rng.Value = myar
    rng.NumberFormat = "yyyy/mm/dd"
    rng.WrapText = True
    Application.ScreenUpdating = True
End Sub