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
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
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
کامنت