!
Sub ChuanHoaNgay()
Const SHEET_BD As String = "Original" ' tên sheet ban đầu
Const SHEET_TT As String = "Temporary" ' tên sheet tạm thời
Const COLUMN_BD As String = "A" ' cột chính dữ liệu ngày
Dim rg, rg1 As Range
Dim rowCur, rowBeg, rowEnd As Integer
Dim res As Boolean
Dim str, str1, str2, str3 As String
Dim vars As Variant
Worksheets(SHEET_BD).Columns(COLUMN_BD).Copy _
Destination:=Worksheets(SHEET_TT).Columns(COLUMN_BD) ' copy dòng dữ liệu sang sheet tạm thời
rowEnd = Worksheets(SHEET_TT).Range(COLUMN_BD & Rows.Count).End(xlUp).Row ' tìm dòng cuối cùng
rowBeg = 2 ' dữ liệu bắt đầu ở dòng 2, nếu bắt đầu ở dòng 1 thì sửa ở đây
Set rg = Worksheets(SHEET_TT).Range(COLUMN_BD & rowBeg & ":" & COLUMN_BD & rowEnd)
' loại bỏ những ký tự thừa, chr(9) là ký tự xuống dòng
res = rg.Replace(Chr(9), " ")
res = rg.Replace(",", " ")
res = rg.Replace(".", " ")
res = rg.Replace("1st", "1 ")
res = rg.Replace("nd", " ")
res = rg.Replace("rd", " ")
res = rg.Replace("th", " ")
res = rg.Replace("/", " ")
res = rg.Replace("-", " ")
Set rg1 = rg.Offset(0, 1) ' cột tạm thời chứa kết quả để kiểm soát trước khi chép thực thụ
For rowCur = 1 To rowEnd - rowBeg + 1 ' đi tưng ô trong khoảng đã chọn
vars = Split(Application.Trim(rg(rowCur).Value), " ") ' tách chuỗi ra thành từng từ
str1 = "01"
str2 = "01"
str3 = vars(UBound(vars))
If UBound(vars) > 0 Then str2 = vars(UBound(vars) - 1) ' nếu không có tháng thì mặc định là 1
If UBound(vars) > 1 Then str1 = vars(UBound(vars) - 2) ' nếu không có ngày thì mặc định là 1
If Left(str1, 1) > "9" Then ' nếu chuỗi thứ 1 không phải là số thì hoán vị với chuỗi 2
str = str2
str2 = str1
str1 = str
End If
If Left(str2, 1) > "9" Then str2 = Mid("010203040506070809101112", _
InStr("anebarprayunulugepctovec", Mid(str2, 2, 2)), 2) ' đổi tên tháng thành số
rg1(rowCur).Value = str3 & "/" & Format(str2, "00") & "/" & Format(str1, "00")
Next rowCur
' sau khi chạy xong, bạn xem lại cột B ở sheet tạm thời
' nếu tốt rồi thì uncomment (xóa dấu nháy đơn) ở dòng sau
' và chạy lại để code chép kết quả vào sheet ban đầu
' rg1.Copy Destination:=Worksheets(SHEET_BD).Range(rg.Address).Offset(0, 1)
Set rg = Nothing
Set rg1 = Nothing
End Sub
….
Liên hệ: 090.6969.247
Cách làm file Excel quản lý lãi vay
Đăng ký kênh nhé cả nhà
Liên hệ: 090.6969.247