Xin giúp đỡ tính số tháng tham gia liên tục.

phananhvusv · 9/12/19

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 ạ.

VetMini · 13/12/19

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?

Tôi làm việc với code mấy chục năm rồi, mà xem code ở diễn đàn này cũng chưa chắc hiểu hết được.
Muốn hiểu code ở đây thì học theo trường phái code ở đây. Không có cách nào khác.

Chú phần xanh: học 1 khoá cơ bản và 2 quyển sách mà viết diễn giải vấn đề như bài #1 thì có lẽ cái khoá cơ bản kia không hề dạy bạn cách diễn giải vấn đề theo đúng trình tự lô gic.
Nguyên tắc lập trình là nếu diễn giải vấn đề đúng trình tự và lô gic thì coi như đã xong phân nửa. Phần còn lại chỉ là dịch từ diễn giải trên ra code thôi.
2 quyển sách kia có bao nhiêu bài tập? Bạn đã làm hết các bài tập ấy chưa?
Hòi xưa tôi học chỉ có 1 quyển sách nhỏ rí. Nhưng tôi làm không sót một bài tập nào. Mà lúc ấy máy tính còn chưa có mấy cái IDE với chức năng copy/paste-find/replace-debug mạnh như bây giờ. Mỗi bài tập tôi gõ code lại từ đầu. (vả lại lúc mới học đâu có hiểu cái mẹo để giành code vào thư viện)

HieuCD · 13/12/19

phananhvusv đã viết:
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ỉ?

Biến luận lý VNdate là dạng ngày tháng của hệ thống (khai báo trong control panel) kiểu Việt nam
VNdate = true: Máy tính có dạng ngày tháng của hệ thống theo kiểu Việt nam
VNdate = false: Máy tính có dạng ngày tháng của hệ thống theo kiểu Mỹ

phananhvusv · 3/1/20

HieuCD đã viết:
Biến luận lý VNdate là dạng ngày tháng của hệ thống (khai báo trong control panel) kiểu Việt nam
VNdate = true: Máy tính có dạng ngày tháng của hệ thống theo kiểu Việt nam
VNdate = false: Máy tính có dạng ngày tháng của hệ thống theo kiểu Mỹ

Anh Hiếu ơi, anh xem giúp em code này với.

Mã:

Sub dictMadoituong()
Dim dongcuoi As Long
Dim vungchon() As Variant
Dim khoa As String
Dim i As Long
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
With Sheets("DATA")
dongcuoi = .Cells(.Rows.Count, "N").End(xlUp).Row
vungchon = Range("N2:N" & dongcuoi)
For i = 1 To dongcuoi - 1
    khoa = vungchon(i, 1)
    If Not dic.exists(khoa) Then
    dic.Add vungchon(i, 1), 1
    Else
    dic.Item(khoa) = dic.Item(khoa) + 1
    End If
Next i
End With
With Sheets("Sheet1")
Range("a14:a" & dic.Count + 13) = Application.Transpose(dic.keys)
Range("b14:b" & dic.Count + 13) = Application.Transpose(dic.items)
End With
End Sub

Tại sao em dùng With sheets thì nó không gán dic.keys và dic.items vào range được anh nhỉ?
Em thử dùng sheets("sheet1").select thì nếu đang ở sheet khác thì ra kết quả, còn đang ở sheet1 thì ko ra.
Còn vấn đề nữa là em dùng pivottable rồi ghi macro lại, sau đó thử thì máy em chạy ok, chuyển qua máy khác thì bị báo lỗi Run time '05'. Vào debug thì tô vàng chỗ code Pivot này:

Mã:

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "DATA!R1C14:R1048576C15", Version:=xlPivotTableVersion15).CreatePivotTable _
        TableDestination:="Sheet1!R14C1", TableName:="DemMaDoiTuong", DefaultVersion _
        :=xlPivotTableVersion15

Anh xem giúp em với, em cám ơn ạ.

HieuCD · 4/1/20

phananhvusv đã viết:
Anh Hiếu ơi, anh xem giúp em code này với.

Mã:

Sub dictMadoituong() Dim dongcuoi As Long Dim vungchon() As Variant Dim khoa As String Dim i As Long Dim dic As Object Set dic = CreateObject("scripting.dictionary") With Sheets("DATA") dongcuoi = .Cells(.Rows.Count, "N").End(xlUp).Row vungchon = Range("N2:N" & dongcuoi) For i = 1 To dongcuoi - 1 khoa = vungchon(i, 1) If Not dic.exists(khoa) Then dic.Add vungchon(i, 1), 1 Else dic.Item(khoa) = dic.Item(khoa) + 1 End If Next i End With With Sheets("Sheet1") Range("a14:a" & dic.Count + 13) = Application.Transpose(dic.keys) Range("b14:b" & dic.Count + 13) = Application.Transpose(dic.items) End With End Sub

Tại sao em dùng With sheets thì nó không gán dic.keys và dic.items vào range được anh nhỉ?
Em thử dùng sheets("sheet1").select thì nếu đang ở sheet khác thì ra kết quả, còn đang ở sheet1 thì ko ra.
Còn vấn đề nữa là em dùng pivottable rồi ghi macro lại, sau đó thử thì máy em chạy ok, chuyển qua máy khác thì bị báo lỗi Run time '05'. Vào debug thì tô vàng chỗ code Pivot này:

Mã:

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ "DATA!R1C14:R1048576C15", Version:=xlPivotTableVersion15).CreatePivotTable _ TableDestination:="Sheet1!R14C1", TableName:="DemMaDoiTuong", DefaultVersion _ :=xlPivotTableVersion15

Anh xem giúp em với, em cám ơn ạ.

Thiếu dấu "." trước Cells và Range nên nhận diện sai Sheet

Mã:

Sub dictMadoituong()
Dim dongcuoi As Long
Dim vungchon() As Variant
Dim khoa As String
Dim i As Long
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
With Sheets("DATA")
  dongcuoi = .Cells(.Rows.Count, "N").End(xlUp).Row
  vungchon = .Range("N2:N" & dongcuoi).Value
  For i = 1 To dongcuoi - 1
    khoa = vungchon(i, 1)
    If Not dic.exists(khoa) Then
      dic.Add vungchon(i, 1), 1
    Else
      dic.Item(khoa) = dic.Item(khoa) + 1
    End If
  Next i
End With

With Sheets("Sheet1")
  .Range("a14:a" & dic.Count + 13) = Application.Transpose(dic.keys)
  .Range("b14:b" & dic.Count + 13) = Application.Transpose(dic.items)
End With
End Sub

Vấn đề thứ 2 có thể là do "xlPivotTableVersion15", thử thu Macro trên máy bị lổi và so sánh lệnh

phananhvusv · 5/1/20

HieuCD đã viết:
Vấn đề thứ 2 có thể là do "xlPivotTableVersion15", thử thu Macro trên máy bị lổi và so sánh lệnh

Em cũng nghĩ vậy. Vì có vài máy dùng được, còn khác phiên bản Excel thì lỗi. Vậy cách nào sửa được lỗi này vậy anh? nếu em vẫn dùng PivotTable?

HieuCD · 5/1/20

phananhvusv đã viết:
Em cũng nghĩ vậy. Vì có vài máy dùng được, còn khác phiên bản Excel thì lỗi. Vậy cách nào sửa được lỗi này vậy anh? nếu em vẫn dùng PivotTable?

Mình không có nhiều Version office nên không thử được, PivotTable nên làm thủ công, hạn chế dùng code VBA

phananhvusv · 5/1/20

HieuCD đã viết:
Mình không có nhiều Version office nên không thử được, PivotTable nên làm thủ công, hạn chế dùng code VBA

Anh Hiếu xem giúp em code dưới bị báo lỗi sothang chỗ .Countif(sothang, ">59")
Em muốn dùng mảng 1 chiều để lưu kết quả tạm thời, sau đó tính countif trên mảng đó, mà em không hiểu tại sao nó báo lỗi nhỉ?

Mã:

Sub testsothang()
Dim sothang() As Long
Dim tungay As Variant
Dim dongcuoi As Long
Dim ketqua As Variant
Dim i As Long

With Sheets("DATA")
dongcuoi = .Cells(.Rows.Count, "W").End(xlUp).Row
tungay = .Range("w2:w" & dongcuoi).Value
For i = 1 To dongcuoi - 1
ReDim sothang(1 To dongcuoi - 1, 1)
sothang(i, 1) = DateDiff("m", tungay(i, 1), Date)
Next i
End With
Sheets("sheet1").Range("C6").Value = WorksheetFunction.CountIf(sothang, ">59")

End Sub

batman1 · 5/1/20

phananhvusv đã viết:
Anh Hiếu xem giúp em code dưới bị báo lỗi sothang chỗ .Countif(sothang, ">59")
Em muốn dùng mảng 1 chiều để lưu kết quả tạm thời, sau đó tính countif trên mảng đó, mà em không hiểu tại sao nó báo lỗi nhỉ?
Sheets("sheet1").Range("C6").Value = WorksheetFunction.CountIf(sothang, ">59")

Không được hỏi nên hơi vô duyên.

Tham số đầu tiên của WorksheetFunction.CountIf phải là đối tượng Range, tức là một vùng trên sheet. Mảng sothang thì dĩ nhiên không phải là đối tượng Range rồi.
-------------
Cái sai cơ bản (sau khi học 1 khoá cơ bản và 2 quyển sách) là Redim đặt trong vòng lặp FOR. Không chỉ tốn điện nước mà do Redim (không phải Redim Preserve) trong vòng lặp nên cuối cùng mảng sothang chỉ có dữ liệu ở dòng cuối cùng, do thực hiện vòng lặp cuối cùng, còn các dòng khác có giá trị 0. Tức các giá trị tính được trước đó do FOR đổ mồ hôi nước mắt, lao động cật lực, sẽ bị xóa hết. Tất nhiên thêm Preserve sau Redim (trong vòng FOR) cũng không được vì không thay đổi được số dòng. Chỉ có thể thay đổi được số cột.

Redim làm 1 lần trước vòng FOR thôi.

phananhvusv · 5/1/20

batman1 đã viết:
Không được hỏi nên hơi vô duyên.

Tham số đầu tiên của WorksheetFunction.CountIf phải là đối tượng Range, tức là một vùng trên sheet. Mảng sothang thì dĩ nhiên không phải là đối tượng Range rồi.
-------------
Cái sai cơ bản (sau khi học 1 khoá cơ bản và 2 quyển sách) là Redim đặt trong vòng lặp FOR. Không chỉ tốn điện nước mà do Redim (không phải Redim Preserve) trong vòng lặp nên cuối cùng mảng sothang chỉ có dữ liệu ở dòng cuối cùng, do thực hiện vòng lặp cuối cùng, còn các dòng khác có giá trị 0. Tức các giá trị tính được trước đó do FOR đổ mồ hôi nước mắt, lao động cật lực, sẽ bị xóa hết. Tất nhiên thêm Preserve sau Redim (trong vòng FOR) cũng không được vì không thay đổi được số dòng. Chỉ có thể thay đổi được số cột.

Redim làm 1 lần trước vòng FOR thôi.

Ha ha, không vô duyên đâu ạ.

Dạ, cái vụ redim là do lúc sửa code em copy paste nhầm mà không hay, chứ ko phải em viết vậy. Cám ơn anh đã nhắc nhở, em đã sửa rồi ạ.
Anh giúp em cái vụ Countif với ạ, nếu em muốn đếm có điều kiện từ cái mảng đó (dữ liệu lớn quá nên em không muốn gán vào sheet sẽ gây chậm) thì có cách nào khác không ạ?

batman1 · 5/1/20

phananhvusv đã viết:
Ha ha, không vô duyên đâu ạ.
Dạ, cái vụ redim là do lúc sửa code em copy paste nhầm mà không hay, chứ ko phải em viết vậy. Cám ơn anh đã nhắc nhở, em đã sửa rồi ạ.
Anh giúp em cái vụ Countif với ạ, nếu em muốn đếm có điều kiện từ cái mảng đó (dữ liệu lớn quá nên em không muốn gán vào sheet sẽ gây chậm) thì có cách nào khác không ạ?

Code ví dụ

Mã:

Sub testsothang()
Dim tungay()
Dim dongcuoi As Long, sothang As Long, ketqua As Long, i As Long
    With ThisWorkbook.Worksheets("DATA")
        dongcuoi = .Cells(Rows.Count, "W").End(xlUp).Row
        If dongcuoi < 2 Then Exit Sub
    '    lay du  dong
        tungay = .Range("w2:w" & dongcuoi + 1).Value
    End With
'    khong xet dong lay du
    For i = 1 To UBound(tungay) - 1
        sothang = DateDiff("m", tungay(i, 1), Date)
        If sothang > 59 Then ketqua = ketqua + 1
    Next i
    Sheets("sheet1").Range("C6").Value = ketqua
End Sub

Điều kiện: dữ liệu cột W phải là ngày tháng theo cách hiểu của Excel. Hiên thời trong cột W không là ngày tháng chuẩn, chỉ là giả bộ ngày tháng. Thử như sau
nhập công thức ở đâu đó

Mã:

=W2+1

Trên máy tôi kết quả là #VALUE!

phananhvusv · 5/1/20

batman1 đã viết:
Code ví dụ

Mã:

Sub testsothang() Dim tungay() Dim dongcuoi As Long, sothang As Long, ketqua As Long, i As Long With ThisWorkbook.Worksheets("DATA") dongcuoi = .Cells(Rows.Count, "W").End(xlUp).Row If dongcuoi < 2 Then Exit Sub ' lay du dong tungay = .Range("w2:w" & dongcuoi + 1).Value End With ' khong xet dong lay du For i = 1 To UBound(tungay) - 1 sothang = DateDiff("m", tungay(i, 1), Date) If sothang > 59 Then ketqua = ketqua + 1 Next i Sheets("sheet1").Range("C6").Value = ketqua End Sub

Điều kiện: dữ liệu cột W phải là ngày tháng theo cách hiểu của Excel. Hiên thời trong cột W không là ngày tháng chuẩn, chỉ là giả bộ ngày tháng. Thử như sau
nhập công thức ở đâu đó

Mã:

=W2+1

Trên máy tôi kết quả là #VALUE!

Code phía trên của em đâu có dư dòng nhỉ?
Em thử ?W2+1 =1
Có 1 điều em thấy lạ, hàm Datediff trong VBA và hàm Datedif của Excel không ra giống kết quả.
Em thử Datediff ("m", "12/31/2019","01/01/2020") thì nó =1, trong khi dùng Datedif bên Excel sẽ =0. Kết quả em cần là phải tính tròn tháng, ví dụ ngày 1/1/2019 đến 31/1/2019 phải là 1 tháng, còn 1/1/2019 đến 30/1/2019 thì =0. Datedif của Excel thì em phải cộng thêm 1 ngày để nó tính đúng như vậy, vì 1/1/2019 đến 1/2/2019 nó mới tính là 1 tháng.

batman1 · 5/1/20

phananhvusv đã viết:
Code phía trên của em đâu có dư dòng nhỉ?
Em thử ?W2+1 =1
Có 1 điều em thấy lạ, hàm Datediff trong VBA và hàm Datedif của Excel không ra giống kết quả.
Em thử Datediff ("m", "12/31/2019","01/01/2020") thì nó =1, trong khi dùng Datedif bên Excel sẽ =0. Kết quả em cần là phải tính tròn tháng, ví dụ ngày 1/1/2019 đến 31/1/2019 phải là 1 tháng, còn 1/1/2019 đến 30/1/2019 thì =0. Datedif của Excel thì em phải cộng thêm 1 ngày để nó tính đúng như vậy, vì 1/1/2019 đến 1/2/2019 nó mới tính là 1 tháng.

Tôi chỉ đọc 1 bài của bạn và sửa cho hết lỗi. Còn chuyện bạn muốn tính gì thì do tôi không đọc các bài khác trong chủ đề nên không biết.

Nếu bạn muốn tính tròn tháng thì cũng tùy thế nào là tròn tháng theo cách hiểu của bạn.
Bạn cho vd. ngày là 01. Tôi muốn biết cái từ ngày > 1

Vd. ngày 05/12/2019 đến 05/01/2020 theo bạn đã tròn tháng chưa? Theo tôi thì là tròn 1 tháng.
Tức theo tôi từ 05/12/2019 đến tận 04/02/2020 đều chỉ tròn 1 tháng. Từ 05/12/2019 đến ít nhất là 05/02/2020 mới tròn 2 tháng.

Nếu bạn tính tròn tháng như tôi thì sửa trong code của tôi dòng thích hợp thành

Mã:

sothang = DateDiff("m", tungay(i, 1), Date) + (Day(tungay(i, 1)) > Day(Date))

Dấu + chứ không là dấu - vì TRUE trong VBA được ép thành -1

hoặc là

Mã:

sothang = DateDiff("m", tungay(i, 1), Date)
If Day(tungay(i, 1)) > Day(Date) Then sothang = sothang - 1

Tất nhiên dữ liệu trong cột W phải là ngày tháng xịn nhé.

phananhvusv · 5/1/20

batman1 đã viết:
Tôi chỉ đọc 1 bài của bạn và sửa cho hết lỗi. Còn chuyện bạn muốn tính gì thì do tôi không đọc các bài khác trong chủ đề nên không biết.

Nếu bạn muốn tính tròn tháng thì cũng tùy thế nào là tròn tháng theo cách hiểu của bạn.
Bạn cho vd. ngày là 01. Tôi muốn biết cái từ ngày > 1

Vd. ngày 05/12/2019 đến 05/01/2020 theo bạn đã tròn tháng chưa? Theo tôi thì là tròn 1 tháng.
Tức theo tôi từ 05/12/2019 đến tận 04/02/2020 đều chỉ tròn 1 tháng. Từ 05/12/2019 đến ít nhất là 05/02/2020 mới tròn 2 tháng.

Nếu bạn tính tròn tháng như tôi thì sửa trong code của tôi dòng thích hợp thành

Mã:

sothang = DateDiff("m", tungay(i, 1), Date) + (Day(tungay(i, 1)) > Day(Date))

Dấu + chứ không là dấu - vì TRUE trong VBA được ép thành -1

hoặc là

Mã:

sothang = DateDiff("m", tungay(i, 1), Date) If Day(tungay(i, 1)) > Day(Date) Then sothang = sothang - 1

Tất nhiên dữ liệu trong cột W phải là ngày tháng xịn nhé.

Em thử ?day(range("W2")) = 5
?month(range("W3")) = 4
?date = 05/01/2020
Vậy là xịn rồi phải không anh?
Em cám ơn anh nhiều ạ.

batman1 · 6/1/20

phananhvusv đã viết:
Em thử ?day(range("W2")) = 5
?month(range("W3")) = 4
?date = 05/01/2020
Vậy là xịn rồi phải không anh?
Em cám ơn anh nhiều ạ.

Tôi nói bạn kiểm tra trên sheet DATA.

Tôi chỉ lưu ý thôi. Còn bạn làm thế nào là tùy bạn.

Xin giúp đỡ tính số tháng tham gia liên tục.

phananhvusv

Thành viên chính thức

File đính kèm

VetMini

Ăn cùng góc phố

HieuCD

Chuyên gia GPE

phananhvusv

Thành viên chính thức

File đính kèm

HieuCD

Chuyên gia GPE

phananhvusv

Thành viên chính thức

HieuCD

Chuyên gia GPE

phananhvusv

Thành viên chính thức

batman1

Thành viên gạo cội

phananhvusv

Thành viên chính thức

batman1

Thành viên gạo cội

phananhvusv

Thành viên chính thức

batman1

Thành viên gạo cội

phananhvusv

Thành viên chính thức

batman1

Thành viên gạo cội

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

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

Đếm ngược thời gian