Lọc dữ liệu duy nhất, đếm số lần xuất hiện và tính tổng của dữ liệu được lọc (1 người xem)

[baquang1984]

Em nhờ thầy, cô, các anh, chị và các bạn trên diễn đàn viết giúp Code VBA lọc dữ liệu, với yêu cầu của chương trình như sau:
- Em có Sheets"DATA" là sheets chứa dữ liệu lọc và lọc theo số CMND1, Sheets"TONGHOP" là Sheets kết quả của dữ liệu lọc sang theo thứ tự các cột như file đính kèm.
- Khi lọc dữ liệu sang Sheets"TONGHOP" thì các cột từ CQL đến cột Noi_cap2 là dữ liệu duy nhất, còn 3 cột
+ Cột Thua_dat đếm xem có bao nhiêu thửa ở số CMND1 (VD Số CMND1 080397392, CQL là ông Lộc Văn Biển ..... có 1 Thửa)
+ Cột To_BD đếm xem có bao nhiêu tờ bản đồ ở Số CMND1 (VD Số CMND1 080397392, CQL là ông Lộc Văn Biển ..... có 1 Tờ bản đồ)
+ Cột Dien_Tich tính tổng diện tích của các thửa tìm được ở Số CMND1 (VD Số CMND1 080397392, CQL là ông Lộc Văn Biển ..... Diện tích 174,8)
Trên đây là mô tả về điều kiện của chương trình lọc, hoặc kết quả đã được thể hiện trong file đính kèm.
Mong được mọi người giúp đỡ

 

[baquang1984]

Mình xoá file đính kèm bài trước, ban kiểm tra file này xem sao:

Em cảm ơn anh! Em kiểm tra thì còn phần này chưa được anh ạ
[TABLE="class: grid, width: 382, align: center"]
[TR]
[TD]CQL[/TD]
[TD]Diachi_ChuSD[/TD]
[TD]Thua_dat[/TD]
[TD]To_BD[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]3[/TD]
[TD]13[/TD]
[TD]14[/TD]
[/TR]
[TR]
[TD]Mã Ngọc Bằng[/TD]
[TD]Thôn Khuổi Phầy[/TD]
[TD]4 thửa[/TD]
[TD]2 tờ bản đồ[/TD]
[/TR]
[TR]
[TD]Mã Văn Chí[/TD]
[TD]Thôn Khuổi Phầy[/TD]
[TD]38[/TD]
[TD]1 tờ bản đồ[/TD]
[/TR]
[TR]
[TD]Mã Văn Thắng[/TD]
[TD]Thôn Khuổi Phầy[/TD]
[TD]133[/TD]
[TD]1 tờ bản đồ[/TD]
[/TR]
[TR]
[TD]Mã Văn Tiến[/TD]
[TD]Thôn Khuổi Phầy[/TD]
[TD]162[/TD]
[TD]1 tờ bản đồ[/TD]
[/TR]
[TR]
[TD]Vy Văn Bộ[/TD]
[TD]Thôn Khuổi Phầy[/TD]
[TD]2 thửa[/TD]
[TD]2 tờ bản đồ[/TD]
[/TR]
[/TABLE]
Chủ quản lý là mã văn thắng Thửa đất có 1 thửa là thửa 133 và một tờ bản đồ là tờ số 5 và một số hộ khác
Đúng theo yêu cầu của chương trình là
[TABLE="class: grid, width: 382, align: center"]
[TR]
[TD="align: center"]CQL[/TD]
[TD="align: center"]Diachi_ChuSD[/TD]
[TD="align: center"]Thua_dat[/TD]
[TD="align: center"]To_BD[/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: center"]3[/TD]
[TD="align: center"]13[/TD]
[TD="align: center"]14[/TD]
[/TR]
[TR]
[TD="align: center"]Mã Ngọc Bằng[/TD]
[TD="align: center"]Thôn Khuổi Phầy[/TD]
[TD="align: center"]4 thửa[/TD]
[TD="align: center"]2 tờ bản đồ[/TD]
[/TR]
[TR]
[TD="align: center"]Mã Văn Chí[/TD]
[TD="align: center"]Thôn Khuổi Phầy[/TD]
[TD="align: center"]38[/TD]
[TD="align: center"]2[/TD]
[/TR]
[TR]
[TD="align: center"]Mã Văn Thắng[/TD]
[TD="align: center"]Thôn Khuổi Phầy[/TD]
[TD="align: center"]133[/TD]
[TD="align: center"]5[/TD]
[/TR]
[TR]
[TD="align: center"]Mã Văn Tiến[/TD]
[TD="align: center"]Thôn Khuổi Phầy[/TD]
[TD="align: center"]162[/TD]
[TD="align: center"]5[/TD]
[/TR]
[TR]
[TD="align: center"]Vy Văn Bộ[/TD]
[TD="align: center"]Thôn Khuổi Phầy[/TD]
[TD="align: center"]2 thửa[/TD]
[TD="align: center"]2 tờ bản đồ[/TD]
[/TR]
[/TABLE]
Anh kiểm tra lại giúp em ạ
Em cảm ơn anh!

 

[sealand]

Cái này là bạn không đúng nha.
Bạn nói số thửa cũ =1 thì ghi thẳng số tờ bản đồ cũ vào

Giờ bạn nêu bổ xung là số thửa mới=1 thì điền thẳng số hiệu tờ bản đồ mới vào có đúng không?

 

[baquang1984]

Cái này là bạn không đúng nha.
Bạn nói số thửa cũ =1 thì ghi thẳng số tờ bản đồ cũ vào

Giờ bạn nêu bổ xung là số thửa mới=1 thì điền thẳng số hiệu tờ bản đồ mới vào có đúng không?

vâng đúng rồi anh ạ, khi số thửa mới = 1 thì điền luôn số tờ bản đồ mới tím được bên Sheets"DATA" vào ạ
Cảm ơn anh!

 

[sealand]

Bạn sửa 1 câu lệnh sau:

Sub GPExyz()
Dim Dic As Object, sArr(), dArr(), Col(), i As Long, j As Long, k As Long, GPE, Id
.......................................................................................................................................
          For i = 1 To k
                dArr(12, i) = SetVl(dArr(12, i), True)
               [SIZE=3][B][COLOR=#ff0000] dArr(13, i) = SetVl(dArr(13, i), False, Right(Trim(dArr(12, i)), 4) = "th" & ChrW(7917) & "a")[/COLOR][/B][/SIZE]
                dArr(16, i) = SetVl(dArr(16, i), True)
                dArr(15, i) = SetVl(dArr(15, i), False, Right(Trim(dArr(16, i)), 4) = "th" & ChrW(7917) & "a")
                If Right(dArr(16, i), 4) = "th" & ChrW(7917) & "a" Then
                    dArr(18, i) = ""
                    dArr(19, i) = ""
                    dArr(20, i) = ""
                Else
                    dArr(18, i) = Replace(dArr(18, Id), "%", "  ")
                    dArr(19, i) = Replace(dArr(19, Id), "%", "  ")
                    dArr(20, i) = Replace(dArr(20, Id), "%", "  ")
                End If
         Next
With Sheets("TONGHOP")
    .[A5:A1000].Resize(, 22).ClearContents
    If k Then .[A5].Resize(k, 22).Value = WorksheetFunction.Transpose(dArr)
End With
End Sub

 

[baquang1984]

Bạn sửa 1 câu lệnh sau:

Được rồi anh sealand ạ! Code anh viết khó quá đúng thất em không thể hiểu nổi hixxx "Em muốn tham khảo một số Code của các anh để mở rộng vấn đề mình cần làm" thế này mà lần sau có vụ như thế này mà muốn ứng dụng code của anh vào để thực hiện việc khác chắc lại phải làm phiền các anh rồi.
Nếu được anh có thể dành thời gian giải thích giúp em chút được không ạ!
Dù sao cũng cảm ơn anh đã nhiệt tình giúp đỡ.

 

[sealand]

Như rất nhiều người đã tham gia với bạn, việc xây dựng hệ thống dữ liệu ban đầu rất quan trọng. Nó quyết định độ chính xác cũng như khả năng sử lý dữ liệu sau này. Các dữ liệu nên có quy tắc nhất quán khi nhập cũng như kết xuất Báo cáo.
Vậy nên rút kinh nghiệm ngay các vướng mắc của file này để file sau hoàn thiện hơn.

 

[baquang1984]

Như rất nhiều người đã tham gia với bạn, việc xây dựng hệ thống dữ liệu ban đầu rất quan trọng. Nó quyết định độ chính xác cũng như khả năng sử lý dữ liệu sau này. Các dữ liệu nên có quy tắc nhất quán khi nhập cũng như kết xuất Báo cáo.
Vậy nên rút kinh nghiệm ngay các vướng mắc của file này để file sau hoàn thiện hơn.

Em cảm ơn anh và mọi người đã góp ý cho chương trình của em, đây là mẫu bảng biểi để em triển khai trong công tác thành lập hồ sơ địa chính của mình như in các đơn từ cũng như xuất bảng biểu có liên quan.
Một việc mà em rất thích là tham khao Code VBA để có thể mở rộng thêm các công việc khác tương tự như thế này. Do vậy cũng rất mong anh giúp đỡ để kiến thức của em được cải thiện và áp dụng trong công việc hiệu quả hơn.
Cảm ơn anh!

 

[baquang1984]

Bạn sửa 1 câu lệnh sau:

Sub GPExyz()
Dim Dic As Object, sArr(), dArr(), Col(), i As Long, j As Long, k As Long, GPE, Id
.......................................................................................................................................
          For i = 1 To k
                dArr(12, i) = SetVl(dArr(12, i), True)
               [SIZE=3][B][COLOR=#ff0000] dArr(13, i) = SetVl(dArr(13, i), False, Right(Trim(dArr(12, i)), 4) = "th" & ChrW(7917) & "a")[/COLOR][/B][/SIZE]
                dArr(16, i) = SetVl(dArr(16, i), True)
                dArr(15, i) = SetVl(dArr(15, i), False, Right(Trim(dArr(16, i)), 4) = "th" & ChrW(7917) & "a")
                If Right(dArr(16, i), 4) = "th" & ChrW(7917) & "a" Then
                    dArr(18, i) = ""
                    dArr(19, i) = ""
                    dArr(20, i) = ""
                Else
                    dArr(18, i) = Replace(dArr(18, Id), "%", "  ")
                    dArr(19, i) = Replace(dArr(19, Id), "%", "  ")
                    dArr(20, i) = Replace(dArr(20, Id), "%", "  ")
                End If
         Next
With Sheets("TONGHOP")
    .[A5:A1000].Resize(, 22).ClearContents
    If k Then .[A5].Resize(k, 22).Value = WorksheetFunction.Transpose(dArr)
End With
End Sub

Em chào sealand hôm trước anh có giúp em chương trình này, nhưng giờ em muốn cho thêm cột vào Sheets"TONGHOP" và mày mò làm theo của anh như nó chạy không đúng. Mong được anh giúp đỡ
Ở đây các cột em mới cho thêm là Cột AA, AB, AC Sheets"TONGHOP" khi em nhấn vào Buttom "LỌC DANH SÁCH"
Thì những chủ hộ nào có 1 thửa VD Hộ Nông Văn Ngan có một thửa là thửa số 13 tờ bản đồ 23 thì ghi dữ liệu tương ứng của thửa đó ra cột AA, AB, AC Sheets"TONGHOP"
Mong anh sửa giúp em Code trong chương trình ạ
Em cảm ơn anh!