Giúp code quản lý ấn chỉ Bảo hiểm (1 người xem)

[dynamic503]

Tình hình là mình cần 1 file Excel quản lý ấn chỉ Bảo hiểm!
MÌNH MUỐN KHI NHẬP LIỆU NHƯ TRONG FILE MẪU, NHẤN NÚT "CẬP NHẬT" BÊN CẠNH THÌ SỐ LIỆU SẼ ĐƯỢC UPDATE VÀO SHEET "CHI TIẾT"
(VỚI MỖI DÒNG LÀ TỪNG TỜ ẤN CHỈ CỦA TỪNG QUYỂN (VỚI MÃ HOẠT ĐỘNG LÀ 1), CÒN CÁC MÃ HOẠT ĐỘNG KHÁC MÌNH DÙNG HÀM VLOOKUP LÀ ĐƯỢC

Các bạn giúp mình với nhé

Cảm ơn rất nhiều!

Đây là file mẫu View attachment quan ly an chi Bao Hiem.xlsx

 

[dynamic503]

Các bác giúp em với

 

[concogia]

Các bác giúp em với

Với dữ liệu sắp xếp như trong bài, thử code này xem:

Public Sub AnChi()
    Dim Vung, K, kK, I, J, Kq, iHang, Dem, Wf
        Set Wf = Application.WorksheetFunction
        With Sheets("Nhap lieu")
            iHang = Wf.CountIf(.Range(.[B11], .[B50000].End(xlUp)), 1)
            Set Vung = .[B11].Resize(iHang, 8)
        End With
        K = iHang + Wf.Sum(Vung.Columns(8)) - Wf.Sum(Vung.Columns(7))
        ReDim Kq(1 To K, 1 To 5): kK = 1
            For I = 1 To Vung.Rows.Count
                For J = 0 To Vung(I, 8) - Vung(I, 7)
                    Kq(kK + J, 1) = kK + J: Kq(kK + J, 2) = Vung(I, 6): Kq(kK + J, 3) = Vung(I, 7) + J
                    Kq(kK + J, 4) = VBA.DateSerial(Vung(I, 4), Vung(I, 3), Vung(I, 2)): Kq(kK + J, 5) = Vung(I, 5)
                Next J
                    kK = kK + J
            Next I
        Sheets("sheet3").[A2].Resize(K, 5) = Kq
End Sub

Kết quả mình đưa sang sheet3 để kiểm tra với sheet "CHI TIET"

 

[dynamic503]

Với dữ liệu sắp xếp như trong bài, thử code này xem:

Public Sub AnChi()
    Dim Vung, K, kK, I, J, Kq, iHang, Dem, Wf
        Set Wf = Application.WorksheetFunction
        With Sheets("Nhap lieu")
            iHang = Wf.CountIf(.Range(.[B11], .[B50000].End(xlUp)), 1)
            Set Vung = .[B11].Resize(iHang, 8)
        End With
        K = iHang + Wf.Sum(Vung.Columns(8)) - Wf.Sum(Vung.Columns(7))
        ReDim Kq(1 To K, 1 To 5): kK = 1
            For I = 1 To Vung.Rows.Count
                For J = 0 To Vung(I, 8) - Vung(I, 7)
                    Kq(kK + J, 1) = kK + J: Kq(kK + J, 2) = Vung(I, 6): Kq(kK + J, 3) = Vung(I, 7) + J
                    Kq(kK + J, 4) = VBA.DateSerial(Vung(I, 4), Vung(I, 3), Vung(I, 2)): Kq(kK + J, 5) = Vung(I, 5)
                Next J
                    kK = kK + J
            Next I
        Sheets("sheet3").[A2].Resize(K, 5) = Kq
End Sub

Kết quả mình đưa sang sheet3 để kiểm tra với sheet "CHI TIET"

Xem sheet "Sheet 3" nhờ code của bác em thấy kết quả rồi, để em nghiên cwaus tiếp theo xem sao, cảm ơn bác!

 

[dynamic503]

Với dữ liệu sắp xếp như trong bài, thử code này xem:

Public Sub AnChi()
    Dim Vung, K, kK, I, J, Kq, iHang, Dem, Wf
        Set Wf = Application.WorksheetFunction
        With Sheets("Nhap lieu")
            iHang = Wf.CountIf(.Range(.[B11], .[B50000].End(xlUp)), 1)
            Set Vung = .[B11].Resize(iHang, 8)
        End With
        K = iHang + Wf.Sum(Vung.Columns(8)) - Wf.Sum(Vung.Columns(7))
        ReDim Kq(1 To K, 1 To 5): kK = 1
            For I = 1 To Vung.Rows.Count
                For J = 0 To Vung(I, 8) - Vung(I, 7)
                    Kq(kK + J, 1) = kK + J: Kq(kK + J, 2) = Vung(I, 6): Kq(kK + J, 3) = Vung(I, 7) + J
                    Kq(kK + J, 4) = VBA.DateSerial(Vung(I, 4), Vung(I, 3), Vung(I, 2)): Kq(kK + J, 5) = Vung(I, 5)
                Next J
                    kK = kK + J
            Next I
        Sheets("sheet3").[A2].Resize(K, 5) = Kq
End Sub

Kết quả mình đưa sang sheet3 để kiểm tra với sheet "CHI TIET"

Mình thử nhập thêm nhận ấn chỉ từ ABIC Quảng ZTrij mã hoạt động 01 nhưng kết quá tại sheet3 sai rồi bác ạ! bác kiểm tra lại dùm em nhé!

 

[dynamic503]

[TABLE="width: 264"]
[TR]
[TD="class: xl64, width: 264, align: left"]NHẬN ẤN CHỈ TỪ ABIC QUẢNG TRỊ (Mã hoạt động 01) mà các dòng liên tục nhau thì đúng nhưng khi ngắt quãng bằng các nghiệp vụ khác thì kết quả sai bác à![/TD]
[/TR]
[/TABLE]

 

[concogia]

[TABLE="width: 264"]
[TR]
[TD="class: xl64, width: 264, align: left"]NHẬN ẤN CHỈ TỪ ABIC QUẢNG TRỊ (Mã hoạt động 01) mà các dòng liên tục nhau thì đúng nhưng khi ngắt quãng bằng các nghiệp vụ khác thì kết quả sai bác à![/TD]
[/TR]
[/TABLE]

Thì mình đã nói:

Với dữ liệu sắp xếp như trong bài, thử code này xem:

Đưa dữ liệu giả định đầy đủ & cấu trúc dữ liệu thật lên đi, làm một lần khỏi sửa

 

[dynamic503]

Thì mình đã nói:

Đưa dữ liệu giả định đầy đủ & cấu trúc dữ liệu thật lên đi, làm một lần khỏi sửa

Đây bác! Cảm ơn bác!

 

[dynamic503]

dữ liệu cập nhật thêm nũa nhé bác!

 

[dynamic503]

Bác cho em thêm 1 cột ghi chú cho từng quyển nữa bác nhé, em cảm ơn!

 

[concogia]

Đây bác! Cảm ơn bác!

Ban gán code này vào nút rồi chạy thử xem sao

Public Sub AnChi()
    Dim Vung, K, kK, I, J, Kq, iHang, Dem, Wf
        Set Wf = Application.WorksheetFunction
        Set Vung = Range([A11], [A50000].End(xlUp)).Resize(, 9)
        iHang = Wf.CountIf(Vung.Columns(2), 1)
        K = iHang + Wf.SumIf(Vung.Columns(2), 1, Vung.Columns(9)) - Wf.SumIf(Vung.Columns(2), 1, Vung.Columns(8))
        ReDim Kq(1 To K, 1 To 5): kK = 1
            For I = 1 To Vung.Rows.Count
                If Vung(I, 2) = 1 Then
                    For J = 0 To Vung(I, 9) - Vung(I, 8)
                        Kq(kK + J, 1) = kK + J: Kq(kK + J, 2) = Vung(I, 7): Kq(kK + J, 3) = Vung(I, 8) + J
                        Kq(kK + J, 4) = VBA.DateSerial(Vung(I, 5), Vung(I, 4), Vung(I, 3)): Kq(kK + J, 5) = Vung(I, 6)
                    Next J
                        kK = kK + J
                End If
                    
            Next I
        Sheets("sheet3").[A2:H50000].ClearContents
        Sheets("sheet3").[A2].Resize(K, 5) = Kq
End Sub

Mình vẫn để kết quả ở sheet 3, bạn muốn chuyển về sheet "CHI TIET" thì sửa 2 câu cuối

dynamic503
dữ liệu cập nhật thêm nũa nhé bác!

Code này chỉ cho nhập đến 50000 dòng dữ liệu thôi, muốn thêm nữa thì.....sửa nữa

dynamic503

Bác cho em thêm 1 cột ghi chú cho từng quyển nữa bác nhé, em cảm ơn! ​

Cái này mà mình hiểu được mình....chết liền
Thử xem nhé, tới giờ cái đầu còn tưng tưng quá, hông biết sửa đúng hông nữa, có gì nói sau
Thân

 

[dynamic503]

Ban gán code này vào nút rồi chạy thử xem sao

Public Sub AnChi()    Dim Vung, K, kK, I, J, Kq, iHang, Dem, Wf        Set Wf = Application.WorksheetFunction        Set Vung = Range([A11], [A50000].End(xlUp)).Resize(, 9)        iHang = Wf.CountIf(Vung.Columns(2), 1)        K = iHang + Wf.SumIf(Vung.Columns(2), 1, Vung.Columns(9)) - Wf.SumIf(Vung.Columns(2), 1, Vung.Columns(8))        ReDim Kq(1 To K, 1 To 5): kK = 1            For I = 1 To Vung.Rows.Count                If Vung(I, 2) = 1 Then                    For J = 0 To Vung(I, 9) - Vung(I, 8)                        Kq(kK + J, 1) = kK + J: Kq(kK + J, 2) = Vung(I, 7): Kq(kK + J, 3) = Vung(I, 8) + J                        Kq(kK + J, 4) = VBA.DateSerial(Vung(I, 5), Vung(I, 4), Vung(I, 3)): Kq(kK + J, 5) = Vung(I, 6)                    Next J                        kK = kK + J                End If                                Next I        Sheets("sheet3").[A2:H50000].ClearContents        Sheets("sheet3").[A2].Resize(K, 5) = KqEnd Sub

Mình vẫn để kết quả ở sheet 3, bạn muốn chuyển về sheet "CHI TIET" thì sửa 2 câu cuốiCode này chỉ cho nhập đến 50000 dòng dữ liệu thôi, muốn thêm nữa thì.....sửa nữaCái này mà mình hiểu được mình....chết liền Thử xem nhé, tới giờ cái đầu còn tưng tưng quá, hông biết sửa đúng hông nữa, có gì nói sauThân

Em online bằng điện thoại nên chưa thử code được. Ý em là em muốn thêm 1 cột "Ghi chú" phía sau cột từ số... đến số để ghi chú thêm thông tin tình trạng ấn chỉ. Ví dụ ghi chú "ấn chỉ hỏng" hoặc "đã nộp tiền" chẳng hạn. Khi chọn cập nhật thì ghi chú đó thể hiện qua sheet 3 của từng tờ ấn chỉCảm ơn bác!

 

[dynamic503]

Ban gán code này vào nút rồi chạy thử xem sao

Public Sub AnChi()
    Dim Vung, K, kK, I, J, Kq, iHang, Dem, Wf
        Set Wf = Application.WorksheetFunction
        Set Vung = Range([A11], [A50000].End(xlUp)).Resize(, 9)
        iHang = Wf.CountIf(Vung.Columns(2), 1)
        K = iHang + Wf.SumIf(Vung.Columns(2), 1, Vung.Columns(9)) - Wf.SumIf(Vung.Columns(2), 1, Vung.Columns(8))
        ReDim Kq(1 To K, 1 To 5): kK = 1
            For I = 1 To Vung.Rows.Count
                If Vung(I, 2) = 1 Then
                    For J = 0 To Vung(I, 9) - Vung(I, 8)
                        Kq(kK + J, 1) = kK + J: Kq(kK + J, 2) = Vung(I, 7): Kq(kK + J, 3) = Vung(I, 8) + J
                        Kq(kK + J, 4) = VBA.DateSerial(Vung(I, 5), Vung(I, 4), Vung(I, 3)): Kq(kK + J, 5) = Vung(I, 6)
                    Next J
                        kK = kK + J
                End If
                    
            Next I
        Sheets("sheet3").[A2:H50000].ClearContents
        Sheets("sheet3").[A2].Resize(K, 5) = Kq
End Sub

Mình vẫn để kết quả ở sheet 3, bạn muốn chuyển về sheet "CHI TIET" thì sửa 2 câu cuối

Code này chỉ cho nhập đến 50000 dòng dữ liệu thôi, muốn thêm nữa thì.....sửa nữa

Cái này mà mình hiểu được mình....chết liền
Thử xem nhé, tới giờ cái đầu còn tưng tưng quá, hông biết sửa đúng hông nữa, có gì nói sau
Thân

Chạy code này bị báo lỗi ở
Kq(kK + J, 4) = VBA.DateSerial(Vung(I, 5), Vung(I, 4), Vung(I, 3))
Bác xem lại giúp em với

 

[concogia]

Chạy code này bị báo lỗi ở
Kq(kK + J, 4) = VBA.DateSerial(Vung(I, 5), Vung(I, 4), Vung(I, 3))
Bác xem lại giúp em với

Muốn giúp lắm nhưng mình chạy code chẳng thấy nó cự nự gì cả. Híc
Thân

 

[dynamic503]

Muốn giúp lắm nhưng mình chạy code chẳng thấy nó cự nự gì cả. Híc
Thân

Chạy fie bác thì ok cả!, chắc do file em nó lệch cái j đó rồi, giờ em lấy file của bác, với thêm 1 cột "Ghi chú" đằng sau cột "Seri ấn tờ cuối", bác xem giúp em với nhé để cập nhật nội dung của ghi chú đó sang "sheet3" theo từng tờ ấn chỉ
Cảm ơn bác! (File em kèm theo đây View attachment quan ly an chi Bao Hiem-123.xlsm)

(Để thuận tiện bác cho cái cột "Ghi chú" vào đăng trước cột "Seri tờ đầu" thì càng tốt, thanks bác!)

 

[concogia]

Chạy fie bác thì ok cả!, chắc do file em nó lệch cái j đó rồi, giờ em lấy file của bác, với thêm 1 cột "Ghi chú" đằng sau cột "Seri ấn tờ cuối", bác xem giúp em với nhé để cập nhật nội dung của ghi chú đó sang "sheet3" theo từng tờ ấn chỉ
Cảm ơn bác! (File em kèm theo đây View attachment 137728)

(Để thuận tiện bác cho cái cột "Ghi chú" vào đăng trước cột "Seri tờ đầu" thì càng tốt, thanks bác!)

(Để thuận tiện bác cho cái cột "Ghi chú" vào đăng trước cột "Seri tờ đầu" thì càng tốt, thanks bác!)

Cái này hiểu "mơ huyền hồ" thôi, làm đại nhé, trật làm tiếp
Thân

 

[dynamic503]

Cái này hiểu "mơ huyền hồ" thôi, làm đại nhé, trật làm tiếp
Thân

Hoàn hảo rồi, cảm ơn bác, nếu có j em hỏi bác tiếp nhé!