DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub Tarihe_Cevir()
Dim i As Long
Application.ScreenUpdating = False
Columns("G:H").Delete
Columns("A:A").Copy Range("F1")
Columns("B:B").Copy Range("I1")
Range("F:F,I:I").Replace What:="/", Replacement:="."
Columns("F:F").TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Columns("I:I").TextToColumns Destination:=Range("I1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
Columns("G:H").Delete Shift:=xlToLeft
Columns("H:I").Delete Shift:=xlToLeft
Columns("F:G").NumberFormat = "m/d/yyyy"
For i = 2 To [F65536].End(3).Row
Cells(i, "F") = CDbl(CDate(Cells(i, "F")))
Cells(i, "G") = CDbl(CDate(Cells(i, "G")))
Next i
Columns("F:F").NumberFormat = "m/d/yyyy"
Application.ScreenUpdating = True
MsgBox "Düzenleme Bitmiştir....", vbInformation, "N.Y"
End Sub
örnek olarak 02.10.1984 şeklinde istiyorum tüm sütunlardaki verileri. Sizin çalışmanız sanırım yardımcı olmuyor bu konuda.
Sub Tarihe_Cevir()
Dim i As Long
Dim a() As String
Dim Sonsat As Long
Application.ScreenUpdating = False
Sonsat = [A65536].End(3).Row
Range("F2:G" & Sonsat).ClearContents
For i = 2 To Sonsat
a = Split(Cells(i, "A"), " ")
If IsDate(a(0)) Then Cells(i, "F") = CDate(a(0))
a = Split(Cells(i, "B"), " ")
If IsDate(a(0)) Then Cells(i, "G") = CDate(a(0))
Next i
Application.ScreenUpdating = True
MsgBox "Düzenleme Bitmiştir....", vbInformation, "N.Y"
End Sub