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

HieuCD

Chuyên gia GPE
Tham gia ngày
14 Tháng chín 2010
Bài viết
6,772
Được thích
13,007
Điểm
1,560
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

LienDong

Thành viên hoạt động
Tham gia ngày
22 Tháng mười một 2012
Bài viết
164
Được thích
41
Điểm
370
Tuổi
46
Nơi ở
Năm Châu Bốn Bể
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.
 

HieuCD

Chuyên gia GPE
Tham gia ngày
14 Tháng chín 2010
Bài viết
6,772
Được thích
13,007
Điểm
1,560
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
 

LienDong

Thành viên hoạt động
Tham gia ngày
22 Tháng mười một 2012
Bài viết
164
Được thích
41
Điểm
370
Tuổi
46
Nơi ở
Năm Châu Bốn Bể
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!
 

HieuCD

Chuyên gia GPE
Tham gia ngày
14 Tháng chín 2010
Bài viết
6,772
Được thích
13,007
Điểm
1,560
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
 

langtusau9x

Thành viên hoạt động
Tham gia ngày
28 Tháng một 2013
Bài viết
101
Được thích
52
Điểm
380
hay quá. đúng cái đang cần luôn ạ. cảm ơn sự phụ nhiều :D
 

HieuCD

Chuyên gia GPE
Tham gia ngày
14 Tháng chín 2010
Bài viết
6,772
Được thích
13,007
Điểm
1,560
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

huonglien1901

GPE là ngôi nhà thứ 2 của tôi!!!
Tham gia ngày
17 Tháng tư 2016
Bài viết
2,405
Được thích
2,009
Điểm
360
Tuổi
28
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

LamNA

Thành viên tích cực
Tham gia ngày
3 Tháng sáu 2014
Bài viết
891
Được thích
707
Điểm
560
Nơi ở
Sóc Trăng
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
 

huonglien1901

GPE là ngôi nhà thứ 2 của tôi!!!
Tham gia ngày
17 Tháng tư 2016
Bài viết
2,405
Được thích
2,009
Điểm
360
Tuổi
28
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

LamNA

Thành viên tích cực
Tham gia ngày
3 Tháng sáu 2014
Bài viết
891
Được thích
707
Điểm
560
Nơi ở
Sóc Trăng
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

huonglien1901

GPE là ngôi nhà thứ 2 của tôi!!!
Tham gia ngày
17 Tháng tư 2016
Bài viết
2,405
Được thích
2,009
Điểm
360
Tuổi
28
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.
 

HieuCD

Chuyên gia GPE
Tham gia ngày
14 Tháng chín 2010
Bài viết
6,772
Được thích
13,007
Điểm
1,560
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

Lần chỉnh sửa cuối:

leonguyenz

Thành viên mới
Thành viên BQT
Moderator
Tham gia ngày
2 Tháng tám 2010
Bài viết
4,564
Được thích
7,993
Điểm
610
Nơi ở
Bình Dương
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
 

HieuCD

Chuyên gia GPE
Tham gia ngày
14 Tháng chín 2010
Bài viết
6,772
Được thích
13,007
Điểm
1,560
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

Top Bottom