Chuyển dữ liệu ngày tháng xuất từ phần mềm không đúng định dạng ngày tháng Excel

Liên hệ QC

HieuCD

Chuyên gia GPE
Tham gia
14/9/10
Bài viết
9,727
Được thích
22,864
Người bạn nhờ viết Function chuyển dữ liệu ngày tháng xuất từ phần mềm kế toán về dạng phù hợp với bảng tính Excel, yêu cầu khá phức tạp và thiết thực với nhiều người nên mình gởi lên cho các bạn có nhu cầu tham khảo
Thuật toán dựa trên sự khác biệt về chênh lệch của từng thành phần: ngày, tháng và năm
Function nên áp dụng cho dữ liệu gốc xuất từ phần mềm chưa qua chế biến
Code chưa test hết các trường hợp nên có thể còn nhiều vấn đề cần phải hoàn thiện, nhờ các bạn góp ý thêm :)
 

File đính kèm

  • ChuyenNgayThang.xlsm
    44.6 KB · Đọc: 63
Cảm ơn bạn cái này tôi đang tìm, nhưng bạn có thể cải cách nó cho dễ sử dụng không?
Ví dụ tôi đang chọn khối ô A2:A10 thì code chỉ chạy trên khối ô này & nó trả kết quả cũng tại khối ô này
Cảm ơn các bạn nhiều.
 
Cảm ơn bạn cái này tôi đang tìm, nhưng bạn có thể cải cách nó cho dễ sử dụng không?
Ví dụ tôi đang chọn khối ô A2:A10 thì code chỉ chạy trên khối ô này & nó trả kết quả cũng tại khối ô này
Cảm ơn các bạn nhiều.
Bạn tùy biến Sub main để xử lý yêu cầu, ví dụ
Mã:
Sub Main()
  Dim sArr(), Res As Variant
  sArr = Range("A2:A10").Value
  Res = ChuyeNgayThang(sArr)
  Range("A2:A10") = Res
End Sub
Thực ra chỉ cần Biến sArr, mình để thêm Biến Res cho bạn dể hình dung
 
Bạn tùy biến Sub main để xử lý yêu cầu, ví dụ
Mã:
Sub Main()
  Dim sArr(), Res As Variant
  sArr = Range("A2:A10").Value
  Res = ChuyeNgayThang(sArr)
  Range("A2:A10") = Res
End Sub
Thực ra chỉ cần Biến sArr, mình để thêm Biến Res cho bạn dể hình dung
Tôi không biết chỉnh những code này, Khối ô chọn là bất kỳ , nên mỗi lần đổi khối ô thì phải đổi code
Các bạn giúp, khi chọn 1 khối ô bất kỳ thì sẽ ra kết quả ở khối ô đó luôn!
 
Tôi không biết chỉnh những code này, Khối ô chọn là bất kỳ , nên mỗi lần đổi khối ô thì phải đổi code
Các bạn giúp, khi chọn 1 khối ô bất kỳ thì sẽ ra kết quả ở khối ô đó luôn!
Dùng code VBA là "hạ thủ bất hoàn" chọn vùng nhầm là tiêu, để mình tinh chỉnh lại code trước rồi viết thủ tục chọn vùng sau
 
hay quá. đúng cái đang cần luôn ạ. cảm ơn sự phụ nhiều :D
 
Tôi không biết chỉnh những code này, Khối ô chọn là bất kỳ , nên mỗi lần đổi khối ô thì phải đổi code
Các bạn giúp, khi chọn 1 khối ô bất kỳ thì sẽ ra kết quả ở khối ô đó luôn!
Code xét thêm vài khả năng ngày tháng không chuẩn
Xem hướng dẫn cách dùng trong File, Nên dán thử kết quả ra ngoài kiểm tra lại rồi dán thực sự vào vị trí dữ liệu
 

File đính kèm

  • ChuyenNgayThang.xlsm
    48.8 KB · Đọc: 38
Người bạn nhờ viết Function chuyển dữ liệu ngày tháng xuất từ phần mềm kế toán về dạng phù hợp với bảng tính Excel, yêu cầu khá phức tạp và thiết thực với nhiều người nên mình gởi lên cho các bạn có nhu cầu tham khảo
Thuật toán dựa trên sự khác biệt về chênh lệch của từng thành phần: ngày, tháng và năm
Function nên áp dụng cho dữ liệu gốc xuất từ phần mềm chưa qua chế biến
Code chưa test hết các trường hợp nên có thể còn nhiều vấn đề cần phải hoàn thiện, nhờ các bạn góp ý thêm :)
Anh Hiếu ơi!
Anh xem giúp em vấn đề này với. Định dạng ngày tháng bị lẫn lộn.(trong file em có định dạng màu để cho dễ nhận dạng)

Em cảm ơn Anh nhiều!
 

File đính kèm

  • Book1 (2) (2).xlsx
    35.6 KB · Đọc: 12
Anh Hiếu ơi!
Anh xem giúp em vấn đề này với. Định dạng ngày tháng bị lẫn lộn.(trong file em có định dạng màu để cho dễ nhận dạng)

Em cảm ơn Anh nhiều!
Chị thử code này thử
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Dim result(), change As Range
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Set change = Intersect(Target, Range("I2:I600000"))
    If Not change Is Nothing Then
        result = change.Resize(change.Rows.Count + 1).Value
        ReDim Preserve result(1 To UBound(result), 1 To 1)
        For i = 1 To UBound(result) - 1
            If Len(result(i, 1)) Then
                result(i, 1) = Format(result(i, 1), "DD/MM/YYYY")
            End If
        Next i
        change.Offset(0, 1).Resize(, 1).Value = result
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 
Chị thử code này thử
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Dim result(), change As Range
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Set change = Intersect(Target, Range("I2:I600000"))
    If Not change Is Nothing Then
        result = change.Resize(change.Rows.Count + 1).Value
        ReDim Preserve result(1 To UBound(result), 1 To 1)
        For i = 1 To UBound(result) - 1
            If Len(result(i, 1)) Then
                result(i, 1) = Format(result(i, 1), "DD/MM/YYYY")
            End If
        Next i
        change.Offset(0, 1).Resize(, 1).Value = result
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Nó vẫn vậy à, vẫn không thay đổi gì cả, ngày tháng vẫn đảo lộn à,

nhờ Anh chỉnh sửa giúp em.

Em cảm ơn Anh.
 

File đính kèm

  • Book1 (2) (2).xlsb
    23.1 KB · Đọc: 5
Nó vẫn vậy à, vẫn không thay đổi gì cả, ngày tháng vẫn đảo lộn à,

nhờ Anh chỉnh sửa giúp em.

Em cảm ơn Anh.
Chị bỏ code vào sheet1 nhe, em sửa lại cột J

Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Dim result(), change As Range
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Set change = Intersect(Target, Range("J2:J600000"))
    If Not change Is Nothing Then
        result = change.Resize(change.Rows.Count + 1).Value
        ReDim Preserve result(1 To UBound(result), 1 To 1)
        For i = 1 To UBound(result) - 1
            If Len(result(i, 1)) Then
                result(i, 1) = Format(result(i, 1), "DD/MM/YYYY")
            End If
        Next i
        change.Offset(0, 1).Resize(, 1).Value = result
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 

File đính kèm

  • Book1 (2) (2).xlsb
    24 KB · Đọc: 14
Chị bỏ code vào sheet1 nhe, em sửa lại cột J

Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Dim result(), change As Range
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Set change = Intersect(Target, Range("J2:J600000"))
    If Not change Is Nothing Then
        result = change.Resize(change.Rows.Count + 1).Value
        ReDim Preserve result(1 To UBound(result), 1 To 1)
        For i = 1 To UBound(result) - 1
            If Len(result(i, 1)) Then
                result(i, 1) = Format(result(i, 1), "DD/MM/YYYY")
            End If
        Next i
        change.Offset(0, 1).Resize(, 1).Value = result
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Bỏ vào Sheet1 vẫn vậy à, Anh xem lại giúp em.
 
Anh Hiếu ơi!
Anh xem giúp em vấn đề này với. Định dạng ngày tháng bị lẫn lộn.(trong file em có định dạng màu để cho dễ nhận dạng)

Em cảm ơn Anh nhiều!
Tạo Function cho riêng bài nầy
Mã:
Sub Main()
  Dim eRow As Long

  eRow = Range("I" & Rows.Count).Row
  If eRow > 1 Then
    Range("H2:H" & eRow).Value = Date_Change(Range("I2:I" & eRow).Value)
  End If
End Sub

Function Date_Change(ByVal sArr As Variant) As Variant
  Dim Res(), i As Long, sRow As Long

  sRow = UBound(sArr)
  ReDim Res(1 To sRow, 1 To 1)
  For i = 1 To sRow
    tmp = sArr(i, 1)
    If TypeName(tmp) = "String" And Len(tmp) = 8 Then
      Res(i, 1) = DateValue(Mid(tmp, 7, 2) & "/" & Mid(tmp, 4, 2) & "/" & Mid(tmp, 1, 2))
    ElseIf IsDate(tmp) Then
      Res(i, 1) = DateValue(Year(tmp) & "/" & Day(tmp) & "/" & Month(tmp))
    End If
  Next i
  Date_Change = Res
End Function
 

File đính kèm

  • Book1 (2) (2).xlsb
    24.2 KB · Đọc: 10
Lần chỉnh sửa cuối:
Tạo Function cho riêng bày nầy
Mã:
Sub Main()
  Dim eRow As Long

  eRow = Range("I" & Rows.Count).Row
  If eRow > 1 Then
    Range("H2:H" & eRow).Value = Date_Change(Range("I2:I" & eRow).Value)
  End If
End Sub

Function Date_Change(ByVal sArr As Variant) As Variant
  Dim Res(), i As Long, sRow As Long

  sRow = UBound(sArr)
  ReDim Res(1 To sRow, 1 To 1)
  For i = 1 To sRow
    tmp = sArr(i, 1)
    If TypeName(tmp) = "String" And Len(tmp) = 8 Then
      Res(i, 1) = DateValue(Mid(tmp, 7, 2) & "/" & Mid(tmp, 4, 2) & "/" & Mid(tmp, 1, 2))
    ElseIf IsDate(tmp) Then
      Res(i, 1) = DateValue(Year(tmp) & "/" & Day(tmp) & "/" & Month(tmp))
    End If
  Next i
  Date_Change = Res
End Function
Kết quả hình như chưa đạt phải không anh?
218440
 
Kết quả hình như chưa đạt phải không anh?
View attachment 218440
Máy mình ra năm 2019
Thử thêm năm đầy đủ xem còn bị không
Mã:
Function Date_Change(ByVal sArr As Variant) As Variant
  Dim Res(), i As Long, sRow As Long
 
  sRow = UBound(sArr)
  ReDim Res(1 To sRow, 1 To 1)
  For i = 1 To sRow
    tmp = sArr(i, 1)
    If TypeName(tmp) = "String" And Len(tmp) = 8 Then
      Res(i, 1) = DateValue(20 & Mid(tmp, 7, 2) & "/" & Mid(tmp, 4, 2) & "/" & Mid(tmp, 1, 2))
    ElseIf IsDate(tmp) Then
      Res(i, 1) = DateValue(Year(tmp) & "/" & Day(tmp) & "/" & Month(tmp))
    End If
  Next i
  Date_Change = Res
End Function
 

File đính kèm

  • Book1 (2) (2).xlsb
    25.3 KB · Đọc: 22
Web KT
Back
Top Bottom