Xin giúp đỡ tính số tháng tham gia liên tục. (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
P

phananhvusv

Thành viên chính thức
Tham gia
28/3/17
Bài viết
72
Được thích
13
Nhờ các anh/chị giúp em với. Em có 1 file gồm 2 sheet, sheet 1 là danh sách tham gia BHYT, với mỗi người là 1 mã số BHXH duy nhất. Sheet 2 là dữ liệu tham gia BHYT theo mã số BHXH. 1 mã số BHXH có nhiều thẻ BHYT. Em muốn tính số tháng tham gia BHYT liên tục của từng người rồi điền vào sheet 1.
Điều kiện tính số tháng liên tục là:
- Thời gian tham gia nối tiếp nhau, hoặc có gián đoạn không quá 3 tháng thì tính là liên tục. (gián đoạn 3 tháng 1 ngày thì tính lại từ đầu). VD: mã số đầu tiên ở Sheet 2, do không tham gia năm 2015 (gián đoạn 12 tháng) nên chỉ được tính liên tục từ 1/1/2016 đến 31/12/2020 là 60 tháng. (và trong năm 2016 mặc dù có 2 thẻ nhưng vẫn chỉ tính 12 tháng)
- Phần thời gian gián đoạn từ 3 tháng trở xuống vẫn được tính là liên tục. VD: mã số A tham gia từ 1/1/2016 - 30/9/2016, sau đó tham gia tiếp từ 1/1/2017 - 31/12/2017, thì số tháng liên tục từ 1/1/2016 - 31/12/2017 là 24 tháng.

Anh/chị có cách nào giúp em với. Em cám ơn nhiều ạ.
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
Bạn kiểm tra số liệu do macro đưa lại xem sao?

(Trước khi chạy macro cần xếp theo mã BHXH & cột bên phải liền kề với cột mã này
 

File đính kèm

Upvote 0
phananhvusv đã viết:
Nhờ các anh/chị giúp em với. Em có 1 file gồm 2 sheet, sheet 1 là danh sách tham gia BHYT, với mỗi người là 1 mã số BHXH duy nhất. Sheet 2 là dữ liệu tham gia BHYT theo mã số BHXH. 1 mã số BHXH có nhiều thẻ BHYT. Em muốn tính số tháng tham gia BHYT liên tục của từng người rồi điền vào sheet 1.
Điều kiện tính số tháng liên tục là:
- Thời gian tham gia nối tiếp nhau, hoặc có gián đoạn không quá 3 tháng thì tính là liên tục. (gián đoạn 3 tháng 1 ngày thì tính lại từ đầu). VD: mã số đầu tiên ở Sheet 2, do không tham gia năm 2015 (gián đoạn 12 tháng) nên chỉ được tính liên tục từ 1/1/2016 đến 31/12/2020 là 60 tháng. (và trong năm 2016 mặc dù có 2 thẻ nhưng vẫn chỉ tính 12 tháng)
- Phần thời gian gián đoạn từ 3 tháng trở xuống vẫn được tính là liên tục. VD: mã số A tham gia từ 1/1/2016 - 30/9/2016, sau đó tham gia tiếp từ 1/1/2017 - 31/12/2017, thì số tháng liên tục từ 1/1/2016 - 31/12/2017 là 24 tháng.

Anh/chị có cách nào giúp em với. Em cám ơn nhiều ạ.
Nhấp chuột vào đây để mở rộng...
Thử Code
Mã: 
Sub SoThangLienTuc()
  Dim aData(), sArr(), Res(), MsBh$
  Dim sRow&, i&, fDay As Date, eDay As Date

  With Sheets("DATA")
    i = .Range("C" & Rows.Count).End(xlUp).Row
    sArr = .Range("A2:C" & i).Value
    .Range("A2:C" & i).Sort .Range("A2"), 1, .Range("B2"), , 1, Header:=xlNo
    aData = .Range("A2:C" & i + 1).Value
    .Range("A2:C" & i).Value = sArr
  End With
 
  With Sheets("STLT")
    sArr = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Value
  End With
 
  With CreateObject("scripting.dictionary")
    sRow = UBound(aData)
    MsBh = aData(1, 1)
    fDay = aData(1, 2)
    eDay = aData(1, 3)
    For i = 1 To sRow - 1
      If DateAdd("m", 3, eDay) <= aData(i, 2) Then
        fDay = aData(i, 2)
        eDay = aData(i, 3)
      Else
        If eDay < aData(i, 3) Then eDay = aData(i, 3)
      End If
      If MsBh <> CStr(aData(i + 1, 1)) Then
        .Add MsBh, DateDiff("m", fDay, eDay) 'tinh tròn thang
        MsBh = aData(i + 1, 1)
        fDay = aData(i + 1, 2)
        eDay = aData(i + 1, 3)
      End If
    Next i
    
    sRow = UBound(sArr)
    ReDim Res(1 To sRow, 1 To 1)
    For i = 1 To sRow
      Res(i, 1) = .Item(CStr(sArr(i, 1)))
    Next i
  End With
 
  With Sheets("STLT")
    .Range("E2").Resize(sRow).Value = Res
  End With
End Sub
 
Upvote 0
SA_DQ đã viết:
Bạn kiểm tra số liệu do macro đưa lại xem sao?

(Trước khi chạy macro cần xếp theo mã BHXH & cột bên phải liền kề với cột mã này
Nhấp chuột vào đây để mở rộng...

Em chạy thử mà ko thấy nó làm gì hết anh ạ.

HieuCD đã viết:
Thử Code
Mã: 
Sub SoThangLienTuc()
  Dim aData(), sArr(), Res(), MsBh$
  Dim sRow&, i&, fDay As Date, eDay As Date

  With Sheets("DATA")
    i = .Range("C" & Rows.Count).End(xlUp).Row
    sArr = .Range("A2:C" & i).Value
    .Range("A2:C" & i).Sort .Range("A2"), 1, .Range("B2"), , 1, Header:=xlNo
    aData = .Range("A2:C" & i + 1).Value
    .Range("A2:C" & i).Value = sArr
  End With

  With Sheets("STLT")
    sArr = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Value
  End With

  With CreateObject("scripting.dictionary")
    sRow = UBound(aData)
    MsBh = aData(1, 1)
    fDay = aData(1, 2)
    eDay = aData(1, 3)
    For i = 1 To sRow - 1
      If DateAdd("m", 3, eDay) <= aData(i, 2) Then
        fDay = aData(i, 2)
        eDay = aData(i, 3)
      Else
        If eDay < aData(i, 3) Then eDay = aData(i, 3)
      End If
      If MsBh <> CStr(aData(i + 1, 1)) Then
        .Add MsBh, DateDiff("m", fDay, eDay) 'tinh tròn thang
        MsBh = aData(i + 1, 1)
        fDay = aData(i + 1, 2)
        eDay = aData(i + 1, 3)
      End If
    Next i
   
    sRow = UBound(sArr)
    ReDim Res(1 To sRow, 1 To 1)
    For i = 1 To sRow
      Res(i, 1) = .Item(CStr(sArr(i, 1)))
    Next i
  End With

  With Sheets("STLT")
    .Range("E2").Resize(sRow).Value = Res
  End With
End Sub
Nhấp chuột vào đây để mở rộng...

Em chưa dò hết, nhưng xem vài trường hợp thì thấy chuẩn rồi á anh.
Em cám ơn 2 anh nhiều ạ.
 
Upvote 0
HieuCD đã viết:
Thử Code
Nhấp chuột vào đây để mở rộng...

Anh cho em hỏi tí với. Em xem code mà không hiểu lắm.
VD trường hợp này: thẻ giá trị :
1/1/2015 - 31/12/2015
1/1/2016 - 31/12/2016
1/1/2018 - 31/12/2018

Nếu vòng lặp chạy qua thẻ 2016 thì nó hiểu là gián đoạn, nhưng chạy tiếp qua thẻ 2015 thì nó có tính thẻ 2015 vào không anh?
If eDay < aData(i, 3) Then eDay = aData(i, 3)
Cái dòng này có ý nghĩa gì trong code trên vậy anh?
 
Upvote 0
phananhvusv đã viết:
Anh cho em hỏi tí với. Em xem code mà không hiểu lắm.
VD trường hợp này: thẻ giá trị :
1/1/2015 - 31/12/2015
1/1/2016 - 31/12/2016
1/1/2018 - 31/12/2018

Nếu vòng lặp chạy qua thẻ 2016 thì nó hiểu là gián đoạn, nhưng chạy tiếp qua thẻ 2015 thì nó có tính thẻ 2015 vào không anh?
If eDay < aData(i, 3) Then eDay = aData(i, 3)
Cái dòng này có ý nghĩa gì trong code trên vậy anh?
Nhấp chuột vào đây để mở rộng...
Mình đã xếp thứ tự theo cột "B" ngày bắt đầu và vòng For chạy từ dòng đầu xuống dòng cuối. Theo ví dụ đầu tiên xét năm 2015 rồi tới 2016 cuối cùng 2018
Xét tới 2016 bị gián đoạn sẽ bỏ toàn bộ dữ liệu trước đó là 2015, tính lại fDay và eDay mới
"If eDay < aData(i, 3) Then eDay = aData(i, 3)"
Xét 2 ví dụ
1/Bình thường
1/1/2016 - 31/12/2016
1/1/2017 - 31/12/2017
Khi xét dòng đầu (2016)
fDay=1/1/2016
eDay =31/12/2016
Khi xét dòng 2 (2017)
eDay < aData(i, 3) thỏa nên eDay = aData(i, 3)=31/12/2017
2/Có thể xảy ra
1/1/2016 - 31/12/2018
1/1/2017 - 31/12/2017
Khi xét dòng đầu (2016)
fDay=1/1/2016
eDay =31/12/2018
Khi xét dòng 2 (2017)
eDay < aData(i, 3) Không thỏa nên eDay vẫn = 31/12/2018
 
Upvote 0
HieuCD đã viết:
Mình đã xếp thứ tự theo cột "B" ngày bắt đầu và vòng For chạy từ dòng đầu xuống dòng cuối. Theo ví dụ đầu tiên xét năm 2015 rồi tới 2016 cuối cùng 2018
Xét tới 2016 bị gián đoạn sẽ bỏ toàn bộ dữ liệu trước đó là 2015, tính lại fDay và eDay mới
"If eDay < aData(i, 3) Then eDay = aData(i, 3)"
Xét 2 ví dụ
1/Bình thường
1/1/2016 - 31/12/2016
1/1/2017 - 31/12/2017
Khi xét dòng đầu (2016)
fDay=1/1/2016
eDay =31/12/2016
Khi xét dòng 2 (2017)
eDay < aData(i, 3) thỏa nên eDay = aData(i, 3)=31/12/2017
2/Có thể xảy ra
1/1/2016 - 31/12/2018
1/1/2017 - 31/12/2017
Khi xét dòng đầu (2016)
fDay=1/1/2016
eDay =31/12/2018
Khi xét dòng 2 (2017)
eDay < aData(i, 3) Không thỏa nên eDay vẫn = 31/12/2018
Nhấp chuột vào đây để mở rộng...

Ôi trời !!! Cái sort này lợi hại thiệt. Nếu không sort thì làm khó hơn hả anh?
À anh Hiếu ơi, cái file của em nó nhiều cột lắm, em tưởng lấy code của anh rồi sửa lại chút là được, mà sao sửa rồi chạy nó báo lỗi tùm lum. Anh xem thử giúp em với. Kết quả anh đưa ra cột Q ở sheets STLT nhe anh.
 

File đính kèm

Upvote 0
phananhvusv đã viết:
Ôi trời !!! Cái sort này lợi hại thiệt. Nếu không sort thì làm khó hơn hả anh?
À anh Hiếu ơi, cái file của em nó nhiều cột lắm, em tưởng lấy code của anh rồi sửa lại chút là được, mà sao sửa rồi chạy nó báo lỗi tùm lum. Anh xem thử giúp em với. Kết quả anh đưa ra cột Q ở sheets STLT nhe anh.
Nhấp chuột vào đây để mở rộng...
Thêm code chuyển ngày tháng
Mã: 
Sub SoThangLienTuc()
  Dim aData(), sArr(), Res(), MsBh$
  Dim sRow&, i&, fDay As Date, eDay As Date

  With Sheets("DATA")
    i = .Range("C" & Rows.Count).End(xlUp).Row
    sArr = .Range("A2:AG" & i).Value
    Call ChuyenNgayThang 'Dang ngay thang sai, phai chuyen dang
    .Range("A2:AG" & i).Sort .Range("C2"), 1, .Range("F2"), , 1, Header:=xlNo
    aData = .Range("C2:G" & i + 1).Value
    .Range("A2:AG" & i).Value = sArr
  End With
 
  With Sheets("STLT")
    dongcuoi = .Range("D" & Rows.Count).End(xlUp).Row 'Bo lenh nay
    .Range("Q1") = "gia tri the cuoi"
    sArr = .Range("D2", .Range("D" & Rows.Count).End(xlUp)).Value
  End With
 
  With CreateObject("scripting.dictionary")
    sRow = UBound(aData)
    MsBh = aData(1, 1)
    fDay = aData(1, 4)
    eDay = aData(1, 5)
    For i = 1 To sRow - 1
      If DateAdd("m", 3, eDay) <= aData(i, 4) Then
        fDay = aData(i, 4)
        eDay = aData(i, 5)
      Else
        If eDay < aData(i, 5) Then eDay = aData(i, 5)
      End If
      If MsBh <> CStr(aData(i + 1, 1)) Then
        .Add MsBh, DateDiff("m", fDay, eDay) 'tinh tròn thang
        MsBh = aData(i + 1, 1)
        fDay = aData(i + 1, 4)
        eDay = aData(i + 1, 5)
      End If
    Next i
    
    sRow = UBound(sArr)
    ReDim Res(1 To sRow, 1 To 1)
    For i = 1 To sRow
      Res(i, 1) = .Item(CStr(sArr(i, 1)))
    Next i
  End With
 
  With Sheets("STLT")
    .Range("Q2").Resize(sRow).Value = Res
  End With
End Sub

Private Sub ChuyenNgayThang()
  Dim sArr(), eRow&, sRow&, i&, j&, tmp
  If Day(DateValue("1/5/2019")) = 1 Then Exit Sub
  With Sheets("DATA")
    eRow = .Range("G" & Rows.Count).End(xlUp).Row
    sArr = .Range("F2:G" & eRow).Value
  End With
  sRow = UBound(sArr)
  For i = 1 To sRow
    For j = 1 To 2
      tmp = sArr(i, j)
      If TypeName(tmp) = "Date" Then
        sArr(i, j) = DateSerial(Year(tmp), Day(tmp), Month(tmp))
      Else
        sArr(i, j) = DateValue(Mid(tmp, 7, 4) & Mid(tmp, 3, 4) & Mid(tmp, 1, 2))
      End If
    Next j
  Next i
  Sheets("DATA").Range("F2:G" & eRow) = sArr
End Sub
 
Upvote 0
phananhvusv đã viết:
Nó ra sai kết quả anh Hiếu ơi. Hình như lệnh sort bị sai thì phải, nó không chịu sort. Mà em thấy định dạng ngày tháng đâu có sai đâu nhỉ?
Nhấp chuột vào đây để mở rộng...
Có một số dòng ngày tháng dạng Text
Nhầm cột ngày, chỉnh lại
Mã: 
Sub SoThangLienTuc()
  Dim aData(), sArr(), Res(), MsBh$
  Dim sRow&, i&, fDay As Date, eDay As Date

  With Sheets("DATA")
    i = .Range("C" & Rows.Count).End(xlUp).Row
    sArr = .Range("A2:AG" & i).Value
    Call ChuyenNgayThang 'Dang ngay thang sai, phai chuyen dang
    .Range("A2:AG" & i).Sort .Range("C2"), 1, .Range("F2"), , 1, Header:=xlNo
    aData = .Range("C2:G" & i + 1).Value
    .Range("A2:AG" & i).Value = sArr
  End With
 
  With Sheets("STLT")
   sArr = .Range("D2", .Range("D" & Rows.Count).End(xlUp)).Value
  End With
 
  With CreateObject("scripting.dictionary")
    sRow = UBound(aData)
    MsBh = aData(1, 1)
    fDay = aData(1, 4)
    eDay = aData(1, 5)
    For i = 1 To sRow - 1
      If DateAdd("m", 3, eDay) <= aData(i, 4) Then
        fDay = aData(i, 4)
        eDay = aData(i, 5)
      Else
        If eDay < aData(i, 5) Then eDay = aData(i, 5)
      End If
      If MsBh <> CStr(aData(i + 1, 1)) Then
        .Add MsBh, DateDiff("m", fDay, eDay) 'tinh tròn thang
        MsBh = aData(i + 1, 1)
        fDay = aData(i + 1, 4)
        eDay = aData(i + 1, 5)
      End If
    Next i
    
    sRow = UBound(sArr)
    ReDim Res(1 To sRow, 1 To 1)
    For i = 1 To sRow
      Res(i, 1) = .Item(CStr(sArr(i, 1)))
    Next i
  End With
 
  With Sheets("STLT")
    .Range("Q2").Resize(sRow).Value = Res
  End With
End Sub

Private Sub ChuyenNgayThang()
  Dim sArr(), eRow&, sRow&, i&, j&, tmp, VNdate As Boolean
 
  With Sheets("DATA")
    eRow = .Range("G" & Rows.Count).End(xlUp).Row
    sArr = .Range("F2:G" & eRow).Value
  End With
  sRow = UBound(sArr)
  If Day(DateValue("1/5/2019")) = 1 Then VNdate = True
  For i = 1 To sRow
    For j = 1 To 2
      tmp = sArr(i, j)
      If TypeName(tmp) = "String" Then
        If VNdate = False Then
          sArr(i, j) = DateValue(Mid(tmp, 7, 4) & Mid(tmp, 3, 4) & Mid(tmp, 1, 2))
        Else
          sArr(i, j) = DateValue(tmp)
        End If
      End If
    Next j
  Next i
  Sheets("DATA").Range("F2:G" & eRow) = sArr
End Sub
 
Upvote 0
HieuCD đã viết:
Có một số dòng ngày tháng dạng Text
Nhầm cột ngày, chỉnh lại
Nhấp chuột vào đây để mở rộng...

Anh Hiếu ơi, cái cột ngày tháng sau khi chỉnh lại nó đảo ngày tháng rồi, VD 01/10/2015 thì thành 10/01/2015
Với cái cột Mã số BHXH chuyển sang dạng số thì nhiều trường hợp bị mất số 0. VD 0113146392.
Cái datedif nó tính số tháng sao vậy anh? VD 1/1/2015 - 31/12/2015 thì có đúng là 12 tháng ko anh? Tại vì em dùng hàm datedif của excel thì nó tính là 11 tháng à, em phải cộng thêm 1 ngày vô cột cuối để nó tính là 12 tháng cho đúng á.
 
Upvote 0
phananhvusv đã viết:
Anh Hiếu ơi, cái cột ngày tháng sau khi chỉnh lại nó đảo ngày tháng rồi, VD 01/10/2015 thì thành 10/01/2015
Với cái cột Mã số BHXH chuyển sang dạng số thì nhiều trường hợp bị mất số 0. VD 0113146392.
Cái datedif nó tính số tháng sao vậy anh? VD 1/1/2015 - 31/12/2015 thì có đúng là 12 tháng ko anh? Tại vì em dùng hàm datedif của excel thì nó tính là 11 tháng à, em phải cộng thêm 1 ngày vô cột cuối để nó tính là 12 tháng cho đúng á.
Nhấp chuột vào đây để mở rộng...
"đảo ngày tháng rồi, VD 01/10/2015 thì thành 10/01/2015 " ở cột nào dòng nào?
"cột Mã số BHXH chuyển sang dạng số thì nhiều trường hợp bị mất số 0. VD 0113146392. " Mình đâu có đụng gì cột nầy
Chỉnh lại lệnh
Mã: 
Sub SoThangLienTuc()
  Dim aData(), sArr(), Res(), MsBh$, tmp$
  Dim sRow&, i&, fDay As Date, eDay As Date, SoThang&

  With Sheets("DATA")
    i = .Range("C" & Rows.Count).End(xlUp).Row
    sArr = .Range("A2:AG" & i).Value
    Call ChuyenNgayThang 'Dang ngay thang sai, phai chuyen dang
    .Range("A2:AG" & i).Sort .Range("C2"), 1, .Range("F2"), , 1, Header:=xlNo
    aData = .Range("C2:G" & i + 1).Value
    .Range("A2:AG" & i).Value = sArr
  End With
 
  With Sheets("STLT")
   sArr = .Range("D2", .Range("D" & Rows.Count).End(xlUp)).Value
  End With
 
  With CreateObject("scripting.dictionary")
    sRow = UBound(aData)
    MsBh = Format(aData(1, 1), "0000000000") 'Ma So co 10 ky tu
    fDay = aData(1, 4)
    eDay = aData(1, 5)
    For i = 1 To sRow - 1
      If DateAdd("m", 3, eDay) <= aData(i, 4) Then
        fDay = aData(i, 4)
        eDay = aData(i, 5)
      Else
        If eDay < aData(i, 5) Then eDay = aData(i, 5)
      End If
      tmp = Format(aData(i + 1, 1), "0000000000")
      If MsBh <> tmp Then
        SoThang = DateDiff("m", fDay, eDay + 1)
        If DateAdd("m", SoThang, fDay) - 1 > eDay Then SoThang = SoThang - 1
        .Add MsBh, SoThang
        MsBh = tmp
        fDay = aData(i + 1, 4)
        eDay = aData(i + 1, 5)
      End If
    Next i
    
    sRow = UBound(sArr)
    ReDim Res(1 To sRow, 1 To 1)
    For i = 1 To sRow
      Res(i, 1) = .Item(Format(sArr(i, 1), "0000000000"))
    Next i
  End With
 
  With Sheets("STLT")
    .Range("Q2").Resize(sRow).Value = Res
  End With
End Sub
 
Upvote 0
Ngay dòng đầu tiên trong sheet data, lúc copy vô là ngày 01/08/2019, chạy code xong thì thấy bị đảo lại thành 08/01/2019 nên số liệu ra bị sai á anh. Với lại em không thấy nó sort được theo cột "Từ ngày" anh ơi.
 

File đính kèm

Upvote 0
phananhvusv đã viết:
Ngay dòng đầu tiên trong sheet data, lúc copy vô là ngày 01/08/2019, chạy code xong thì thấy bị đảo lại thành 08/01/2019 nên số liệu ra bị sai á anh. Với lại em không thấy nó sort được theo cột "Từ ngày" anh ơi.
Nhấp chuột vào đây để mở rộng...
Chỉnh lại code
Mã: 
Sub SoThangLienTuc()
  Dim aData(), sArr(), Res(), MsBh$, tmp$
  Dim sRow&, i&, fDay As Date, eDay As Date, SoThang&

  With Sheets("DATA")
    Call CreateArr(aData)
  End With
  With Sheets("STLT")
   sArr = .Range("D2", .Range("D" & Rows.Count).End(xlUp)).Value
  End With
 
  With CreateObject("scripting.dictionary")
    sRow = UBound(aData)
    MsBh = Format(aData(1, 1), "0000000000") 'Ma So co 10 ky tu
    fDay = aData(1, 4)
    eDay = aData(1, 5)
    For i = 1 To sRow - 1
      If DateAdd("m", 3, eDay) <= aData(i, 4) Then
        fDay = aData(i, 4)
        eDay = aData(i, 5)
      Else
        If eDay < aData(i, 5) Then eDay = aData(i, 5)
      End If
      tmp = Format(aData(i + 1, 1), "0000000000")
      If MsBh <> tmp Then
        SoThang = DateDiff("m", fDay, eDay + 1)
        If DateAdd("m", SoThang, fDay) - 1 > eDay Then SoThang = SoThang - 1
        .Add MsBh, SoThang
        MsBh = tmp
        fDay = aData(i + 1, 4)
        eDay = aData(i + 1, 5)
      End If
    Next i
    
    sRow = UBound(sArr)
    ReDim Res(1 To sRow, 1 To 1)
    For i = 1 To sRow
      Res(i, 1) = .Item(Format(sArr(i, 1), "0000000000"))
    Next i
  End With
 
  With Sheets("STLT")
    .Range("Q2").Resize(sRow).Value = Res
  End With
End Sub

Private Sub CreateArr(ByRef aData)
  Dim sArr(), Arr() As String, eRow&, sRow&, sCol&, i&, j&, tmp, VNdate As Boolean
 
  With Sheets("DATA")
    eRow = .Range("G" & Rows.Count).End(xlUp).Row
    sArr = .Range("C2:G" & eRow).Value
    sRow = UBound(sArr): sCol = UBound(sArr, 2)
    ReDim Arr(1 To sRow, 1 To sCol)
    For i = 1 To sRow
      For j = 1 To sCol
        Arr(i, j) = CStr(sArr(i, j))
      Next j
    Next i
    sArr = .Range("F2:G" & eRow).Value
    If Day(DateValue("1/5/2019")) = 1 Then VNdate = True
    For i = 1 To sRow
      For j = 1 To 2
        tmp = sArr(i, j)
        If TypeName(tmp) = "String" Then
          If VNdate = False Then
            sArr(i, j) = DateValue(Mid(tmp, 7, 4) & Mid(tmp, 3, 4) & Mid(tmp, 1, 2))
          Else
            sArr(i, j) = DateValue(tmp)
          End If
        End If
      Next j
    Next i
    .Range("F2:G" & eRow) = sArr
    .Range("C2:G" & eRow).Sort .Range("C2"), 1, .Range("F2"), , 1, Header:=xlNo
    aData = .Range("C2:G" & eRow).Value
    .Range("C2:G" & eRow) = Arr
  End With
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
phananhvusv đã viết:
Em cám ơn anh nhiều ạ, mặc dù em ko thấy nó sort theo cột F, nhưng kết quả vẫn đúng ạ.
Nhấp chuột vào đây để mở rộng...
Không biết file của bạn còn làm tiếp gì không, sao khi xử lý phải trả về nguyên trạng, xóa mọi dấu vết có thể bị khép tội xâm phạm bất hợp pháp
Mở code, click chuột vào sub và bấm phím chức năng F8 rồi bấm F8 ... nhìn trên sheet sẽ thấy vận hành của code
 
Upvote 0
HieuCD đã viết:
Không biết file của bạn còn làm tiếp gì không, sao khi xử lý phải trả về nguyên trạng, xóa mọi dấu vết có thể bị khép tội xâm phạm bất hợp pháp
Mở code, click chuột vào sub và bấm phím chức năng F8 rồi bấm F8 ... nhìn trên sheet sẽ thấy vận hành của code
Nhấp chuột vào đây để mở rộng...
Em không ngờ là có thể làm được vậy luôn. Theo em hiểu, cái code của anh là đưa dữ liệu vào mảng, rồi xử lý trên mảng, chứ không ảnh hưởng gì đến file phải ko anh? Em đã học 1 khóa cơ bản VBA + 2 quyển sách của diễn đàn, mà xem code của anh vẫn chưa hiểu hết được. Em cần phải học gì thêm nữa anh?
 
Upvote 0
phananhvusv đã viết:
Em không ngờ là có thể làm được vậy luôn. Theo em hiểu, cái code của anh là đưa dữ liệu vào mảng, rồi xử lý trên mảng, chứ không ảnh hưởng gì đến file phải ko anh? Em đã học 1 khóa cơ bản VBA + 2 quyển sách của diễn đàn, mà xem code của anh vẫn chưa hiểu hết được. Em cần phải học gì thêm nữa anh?
Nhấp chuột vào đây để mở rộng...
Viết code nhiều sẽ có kinh nghiệm, mình không sách cũng không được học bài bản, chỉ nhờ lên diễn đàn viết code lung tung, sai tá lã... được các bạn hổ trợ nên dần dần hoàn thiện
Xem ghi chú trong sub sẽ hiểu cách vận hành
Mã: 
Private Sub CreateArr(ByRef aData)
  Dim sArr() As Variant, Arr() As String, eRow&, sRow&, sCol&, i&, j&, tmp, VNdate As Boolean
  With Sheets("DATA")
    eRow = .Range("G" & Rows.Count).End(xlUp).Row
    sArr = .Range("C2:G" & eRow).Value 'Gán du lieu vao mang
    sRow = UBound(sArr): sCol = UBound(sArr, 2)
    ReDim Arr(1 To sRow, 1 To sCol) 'Mang du lieu goc dang String theo dinh dang du lieu
'Chuyen mang sArr dang Variant sang mang Arr dang String
    For i = 1 To sRow
      For j = 1 To sCol
        Arr(i, j) = CStr(sArr(i, j))
      Next j
    Next i
'Chuyen Ngay thang theo dang Sting thanh dang Date, bang mang sArr
    sArr = .Range("F2:G" & eRow).Value
    If Day(DateValue("1/5/2019")) = 1 Then VNdate = True
    For i = 1 To sRow
      For j = 1 To 2
        tmp = sArr(i, j)
        If TypeName(tmp) = "String" Then
          If VNdate = False Then
            sArr(i, j) = DateValue(Mid(tmp, 7, 4) & Mid(tmp, 3, 4) & Mid(tmp, 1, 2))
          Else
            sArr(i, j) = DateValue(tmp)
          End If
        End If
      Next j
    Next i
'Gan ngay thang vào sheet
    .Range("F2:G" & eRow) = sArr
'Sort du lieu trong sheet
    .Range("C2:G" & eRow).Sort .Range("C2"), 1, .Range("F2"), , 1, Header:=xlNo
'Lay ket qua sort
    aData = .Range("C2:G" & eRow).Value
'Tra ve gia tri goc cua file
    .Range("C2:G" & eRow) = Arr
  End With
End Sub
 
Upvote 0
HieuCD đã viết:
Viết code nhiều sẽ có kinh nghiệm, mình không sách cũng không được học bài bản, chỉ nhờ lên diễn đàn viết code lung tung, sai tá lã... được các bạn hổ trợ nên dần dần hoàn thiện
Xem ghi chú trong sub sẽ hiểu cách vận hành
Nhấp chuột vào đây để mở rộng...

Cái vụ định dạng ngày tháng đúng là căng thiệt.
If Day(DateValue("1/5/2019")) = 1 Then VNdate = True
Cái này có ý nghĩa gì anh nhỉ? Biến VNdate chỉ có True và False, theo câu trên thì mình xác định là đúng, còn khi nào thì nó False anh nhỉ?
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

GPE-Trợ Lý
[ĐÀ NẴNG] ĐĂNG KÝ THAM DỰ SINH NHẬT GIAIPHAPEXCEL LẦN THỨ 19 NGÀY 13/07/2025
    • Thích
Trả lời
7
Đọc
459
PhanTuHuong
PhanTuHuong
Phan Thế Hiệp
Tìm ngày giờ kết thúc dự kiến (1 người xem)
    • Thích
    • Yêu thích
2
Trả lời
24
Đọc
978
Phan Thế Hiệp
Phan Thế Hiệp
K
xin file excel bảng đấu bóng đá
    • Yêu thích
2 3
Trả lời
42
Đọc
26K
Hoàng Tuấn 868
H
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
17 18 19
Trả lời
372
Đọc
42K
huhong1992
H
B
Xin cách để hiển thị ra các tiêu đề tương ứng của nội dung trong bảng, 1 tiêu đề có nhiều nội dung
Trả lời
7
Đọc
160
Duy Tùng 9x
Duy Tùng 9x
N
xin các cao thủ chỉ cách gỡ lỗi không khởi động được excel
Trả lời
5
Đọc
671
ELDEST 11
ELDEST 11
Q
  • Question Question
Chèn dòng "--------" và giá trị min, max cho WBS cha, con (1 người xem)
Trả lời
0
Đọc
50
quangnn0387
Q
V
Tiện ích in sơ đồ đánh số báo danh cho kỳ thi tuyển sinh vào 10 và tốt nghiệp THPT
Trả lời
0
Đọc
52
vtkmoduc1000
V
P
Xử lý lỗi bị đẩy về sheet đầu trong excel
Trả lời
2
Đọc
390
Hoàng Tuấn 868
H
T
Nhờ hỗ trợ chỉnh phiếu xuất tự động
Trả lời
6
Đọc
152
trungtruong1234
T
Nga1852k
lỗi excel không chèn được dòng và không xóa được dòng
Trả lời
1
Đọc
69
vietduc147258
V
nguyenhoangtuananh9897
Hỏi về nơi tải danh sách xã huyện tỉnh chuẩn
2 3
Trả lời
45
Đọc
3K
SA_DQ
SA_DQ
OrangeBee
Xin nhờ anh chị giúp đỡ về CommandButton Userform. (1 người xem)
Trả lời
3
Đọc
127
ptm0412
ptm0412
N
Tạo COM Add-In bằng Visual C++
Trả lời
1
Đọc
183
nguyendang95
N
ptm0412
Hình ảnh sinh nhật GPE lần 19 tại HCM
    • Thích
    • Yêu thích
Trả lời
0
Đọc
90
ptm0412
ptm0412
K
  • Question Question
Viết code cho file lấy dữ liệu in -out từ bảng chấm công
Trả lời
1
Đọc
136
yaaasoo01
Y
vc_đi chơi
Cộng ngày từ sheet này sang sheet khác bị nhảy lung tung
Trả lời
8
Đọc
178
vc_đi chơi
vc_đi chơi
N
Giãn dòng trong excel
Trả lời
0
Đọc
96
nguyenichky
N
GPE-Trợ Lý
[HCM] ĐĂNG KÝ THAM DỰ SINH NHẬT GIAIPHAPEXCEL LẦN THỨ 19 NGÀY 06/07/2025
    • Thích
    • Yêu thích
Trả lời
14
Đọc
1K
PhanTuHuong
PhanTuHuong
N
  • Question Question
Hỗ trợ tiếng việt trong macro (1 người xem)
Trả lời
10
Đọc
379
ptm0412
ptm0412
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Sinh nhật lần 19 GPE

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom