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 · 24/8/14

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 đỡ

diemhuyenanh · 24/8/14

bạn cho mình hỏi là có khi nào một số CMND mà có 2 công dân cùng sử dụng không nhỉ. nếu mỗi công dân là một số CMND duy nhất không trùng thi sao không lọc theo số CMND mà lại lọc từ cột CQL đến cột nơi cấp 2 nhỉ

ChanhTQ@ · 24/8/14

Bạn có thể bấm {CTRL}+{SHIFT}+F để có kết quả mới & kiểm tra.

;;;;;;;;;;;

Quang_Hải · 24/8/14

baquang1984 đã viết:
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 đỡ

Dữ liệu đất đai mà lủng như cái rổ thì làm sao mần đây. Thôi Dzọt lẹ, anh Ba Tê ơi xử vụ này đi. Em biết mấy vụ này anh khéo lắm

Ba Tê · 24/8/14

quanghai1969 đã viết:
Dữ liệu đất đai mà lủng như cái rổ thì làm sao mần đây. Thôi Dzọt lẹ, anh Ba Tê ơi xử vụ này đi. Em biết mấy vụ này anh khéo lắm

Thấy kiểu đất đai như vậy và hình như cũng "bị theo" những bài như thế này nhiều lần rồi.
Khi rảnh rỗi mới theo nữa. Bi giờ thì người ta "tắt đèn" mà mình ngồi đây làm gì.

dhn46 · 25/8/14

Không ngủ được làm thử, chẳng trúng thì trượt

Mã:

Sub TongHop()
    Dim Arr, Res, i As Long, j As Long, Tmp As Long, k As Long
    Arr = Sheets("DATA").Range("B2:O" & Sheets("DATA").Range("B65536").End(3).Row)
    ReDim Res(1 To UBound(Arr, 1), 1 To UBound(Arr, 2) + 1)
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(Arr, 1)
            If Not .Exists(Arr(i, 4)) Then
                Debug.Print Arr(i, 4)
                k = k + 1
                .Add Arr(i, 4), k
                For j = 1 To 11
                    Res(k, j) = Arr(i, j)
                Next
                Res(k, 12) = 1
                Res(k, 13) = 1
                Res(k, 14) = Arr(i, 14)
                Res(k, 15) = Arr(i, 13)
            Else
                Tmp = .Item(Arr(i, 4))
                Res(Tmp, 12) = Res(Tmp, 12) + 1
                Res(Tmp, 14) = Res(Tmp, 14) + Arr(i, 14)
                If InStr(1, Res(Tmp, 15), Arr(i, 13)) = 0 Then
                    Res(Tmp, 15) = Res(Tmp, 15) & "," & Arr(i, 13)
                    Res(Tmp, 13) = Res(Tmp, 13) + 1
                End If
            End If
        Next
    End With
    Sheets("TONGHOP").[A2:N65536].ClearContents
    Sheets("TONGHOP").Range("A2").Resize(k, 14) = Res
End Sub

baquang1984 · 25/8/14

Em cảm ơn các bác đã nhiệt tình giúp đỡ, số liệu đất đai của em không phải là lủng củng mà em đưa một phần dữ liệu lên vì khối lượng dữ liệu thì nhiều quá!

baquang1984 · 25/8/14

diemhuyenanh đã viết:
bạn cho mình hỏi là có khi nào một số CMND mà có 2 công dân cùng sử dụng không nhỉ. nếu mỗi công dân là một số CMND duy nhất không trùng thi sao không lọc theo số CMND mà lại lọc từ cột CQL đến cột nơi cấp 2 nhỉ

Em cảm ơn anh diemhuyenanh đúng là mỗi công dân có 1 CMND do vậy ở đầu bài em đã yêu cầu là lọc theo số CMND mà "và lọc theo số CMND1"

baquang1984 · 25/8/14

Ba Tê đã viết:
Thấy kiểu đất đai như vậy và hình như cũng "bị theo" những bài như thế này nhiều lần rồi.
Khi rảnh rỗi mới theo nữa. Bi giờ thì người ta "tắt đèn" mà mình ngồi đây làm gì.

Về vấn đề này mấy chương trình anh Ba Tê viết lần trước thật là tuyệt vời. Giờ trời đã sáng rồi anh Ba Tê có thể bớt chút thời gian giúp em được không ạ.
Thanks anh và mọi người trên diễn đàn nhiều!

baquang1984 · 25/8/14

dhn46 đã viết:

Không ngủ được làm thử, chẳng trúng thì trượt

Mã:

Sub TongHop()
    Dim Arr, Res, i As Long, j As Long, Tmp As Long, k As Long
    Arr = Sheets("DATA").Range("B2:O" & Sheets("DATA").Range("B65536").End(3).Row)
    ReDim Res(1 To UBound(Arr, 1), 1 To UBound(Arr, 2) + 1)
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(Arr, 1)
            If Not .Exists(Arr(i, 4)) Then
                Debug.Print Arr(i, 4)
                k = k + 1
                .Add Arr(i, 4), k
                For j = 1 To 11
                    Res(k, j) = Arr(i, j)
                Next
                Res(k, 12) = 1
                Res(k, 13) = 1
                Res(k, 14) = Arr(i, 14)
                Res(k, 15) = Arr(i, 13)
            Else
                Tmp = .Item(Arr(i, 4))
                Res(Tmp, 12) = Res(Tmp, 12) + 1
                Res(Tmp, 14) = Res(Tmp, 14) + Arr(i, 14)
                If InStr(1, Res(Tmp, 15), Arr(i, 13)) = 0 Then
                    Res(Tmp, 15) = Res(Tmp, 15) & "," & Arr(i, 13)
                    Res(Tmp, 13) = Res(Tmp, 13) + 1
                End If
            End If
        Next
    End With
    Sheets("TONGHOP").[A2:N65536].ClearContents
    Sheets("TONGHOP").Range("A2").Resize(k, 14) = Res
End Sub

Em cảm ơn anh dhn46! Với Code này của anh dhn46 thì cơ bản đáp ứng được công việc và dữ liệu hiện tai, tuy nhiên dữ liệu của e có đến 43 cột và có 3 cột nữa cũng làm công việc tương tự như cột 12, 13, 14 Sheets"TONGHOP". Vậy em muốn sửa Code của anh để thêm 3 cột nữa thì cần phải sửa như thế nào ạ, xem code của anh khó quá.
(em gửi file có đủ 43 cột và có thêm 3 cột nữa là cột 15, 16, 17 làm công việc tưng tự như cột 12, 13 ,14 Sheets"TONGHOP" các cột 15, 16, 17 được truy xuất dữ liệu từ cột 28, 29, 30 Sheets"DaTA", tuy nhiên cột 16 Sheets"TONGHOP" khi lọc có khác một chút là đếm số thửa có cả dấu "+" VD như có 3 thửa như sau (157+158+159) và được tính làm 3 thửa có 2 thửa nhưa sau (174+156) và được tính là 2 thửa).
Em làm VD một chủ hộ có Số CMND1 = 080791895 trong file đính kèm!
Mong được anh và mọi người trên diễn đàn giúp đỡ. Em cảm ơn mọi người nhiều!

baquang1984 · 25/8/14

quanghai1969 đã viết:
Dữ liệu đất đai mà lủng như cái rổ thì làm sao mần đây. Thôi Dzọt lẹ, anh Ba Tê ơi xử vụ này đi. Em biết mấy vụ này anh khéo lắm

Anh quanghai1969 vũ lọc dữ liệu kiểu này bác và mọi người giúp em với :;;;:::

sealand · 25/8/14

Ngoài cách dùng VBA, mình thấy dùng Pivot Table cũng nhẹ nhàng và cho độ chính xác cao

baquang1984 · 25/8/14

sealand đã viết:
Ngoài cách dùng VBA, mình thấy dùng Pivot Table cũng nhẹ nhàng và cho độ chính xác cao

Em cảm ơn anh sealand dùng Pivot Table thì cũng được tuy nhiên một việc quan trong là Pivot Table không đếm được các Cell có dự liệu kiểu 157+158+159 như em mô tả ở bài #10. Do vây em muốn nhờ các thầy, cô, các anh, chị và các bạn giúp đỡ xử lý chương trình bằng VBA.
Em cảm ơn mọi người nhiều!

Quang_Hải · 25/8/14

baquang1984 đã viết:
Em cảm ơn anh sealand dùng Pivot Table thì cũng được tuy nhiên một việc quan trong là Pivot Table không đếm được các Cell có dự liệu kiểu 157+158+159 như em mô tả ở bài #10. Do vây em muốn nhờ các thầy, cô, các anh, chị và các bạn giúp đỡ xử lý chương trình bằng VBA.
Em cảm ơn mọi người nhiều!

Mình nói rồi, dạng bài này chỉ có anh Ba Tê làm là ngon lành nhất thôi. Đợi đi, khuya khuya làm anh Ba Tê nhào vô hà.

baquang1984 · 25/8/14

quanghai1969 đã viết:
Mình nói rồi, dạng bài này chỉ có anh Ba Tê làm là ngon lành nhất thôi. Đợi đi, khuya khuya làm anh Ba Tê nhào vô hà.

Vâng em cảm ơn anh!. Em cũng được Bác Ba Tê xử lý giúp mấy chương trình, bác ấy xử lý về lĩnh vực quản lý đất đai cũng oki lắm không biết anh có làm trong ngành quản lý đất đai không???

be_09 · 25/8/14

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

Những cái bạn cần tôi đã làm qua hết rồi, nhưng những bài viết trước đây tôi có góp ý cách thực hiện 1 File theo dõi từ khâu đăng ký, đến khâu xét duyệt, và lập thủ tục cấp giấy chứng nhận quyền sử dụng đất, nhưng bạn không có ý kiến (hình như không có thành ý với cách tôi góp ý). Tính tôi là vậy, nếu tôi góp ý mà không thấy ý kiến là những bài tiếp theo tôi chỉ đọc qua mà không có ý kiến trả lời. Nhưng hôm nay bạn hỏi Quanghai1969

không biết anh có làm trong ngành quản lý đất đai không???

Thì hôm nay tôi viết bài này để bạn biết ai làm trong ngành Tài nguyên và Môi trường.

baquang1984 · 25/8/14

be09 đã viết:
Những cái bạn cần tôi đã làm qua hết rồi, nhưng những bài viết trước đây tôi có góp ý cách thực hiện 1 File theo dõi từ khâu đăng ký, đến khâu xét duyệt, và lập thủ tục cấp giấy chứng nhận quyền sử dụng đất, nhưng bạn không có ý kiến (hình như không có thành ý với cách tôi góp ý). Tính tôi là vậy, nếu tôi góp ý mà không thấy ý kiến là những bài tiếp theo tôi chỉ đọc qua mà không có ý kiến trả lời. Nhưng hôm nay bạn hỏi Quanghai1969
Thì hôm nay tôi viết bài này để bạn biết ai làm trong ngành Tài nguyên và Môi trường.

Vâng em cảm ơn anh đã góp ý, em đã cảm ơn những bài góp ý của anh tuy nhiên các vấn đề của anh góp ý là đối với những người làm trong ngành tài nguyên môi trường liên quan trực tiếp đến công tác quản lý đất đai, và cấp giấy chứng nhận quyền sử dụng đất. Còn vấn đề của em là em hình dùng được vấn đề mình làm là cần cái gì nhưng trình độ về VBA trong excel em lại không có do vậy rất khó cho việc tiếp theo. Nêm phải nhờ đến Thầy, cô, các anh, chị và các bạn trên diễn đàn giúp đỡ về Tạo một chương trình bằng VBA.
Một lần nữa cảm ơn anh đã góp ý!

VetMini · 25/8/14

be09 đã viết:
Những cái bạn cần tôi đã làm qua hết rồi, nhưng những bài viết trước đây tôi có góp ý cách thực hiện 1 File theo dõi từ khâu đăng ký, đến khâu xét duyệt, và lập thủ tục cấp giấy chứng nhận quyền sử dụng đất, nhưng bạn không có ý kiến (hình như không có thành ý với cách tôi góp ý). Tính tôi là vậy, nếu tôi góp ý mà không thấy ý kiến là những bài tiếp theo tôi chỉ đọc qua mà không có ý kiến trả lời. Nhưng hôm nay bạn hỏi Quanghai1969

Thì hôm nay tôi viết bài này để bạn biết ai làm trong ngành Tài nguyên và Môi trường.

Bạn đừng buồn. Bạn đã phí sức cho sai đối tượng.
Có những người đánh giá cao khả năng thiết kế bảng. Khi gặp vấn đề, người ta sửa lại cách thiết kế thế nào cho dễ kiểm soát và phân tích dữ liệu.
Có những người đánh giá cao khả năng làm việc với dữ liệu "thiết kế thế nào cũng được". Khi gặp vấn đề, người ta dựa vào năng lực của VBA để làm việc.

Loại 1 bị người ta khinh rể vì dùng công thức và mấy cái bảng Pivot nó không được "pờ rồ"
Loại 2 được trong vọng hơn, bởi vì chỉ cần hỏi và lấy giải đáp thôi

baquang1984 · 25/8/14

VetMini đã viết:
Bạn đừng buồn. Bạn đã phí sức cho sai đối tượng.

Rất mong muốn được học hỏi và đóng góp ý kiến của anh
Em cảm ơn anh VetMini!

be_09 · 25/8/14

VetMini đã viết:
Bạn đừng buồn. Bạn đã phí sức cho sai đối tượng.
Có những người đánh giá cao khả năng thiết kế bảng. Khi gặp vấn đề, người ta sửa lại cách thiết kế thế nào cho dễ kiểm soát và phân tích dữ liệu.
Có những người đánh giá cao khả năng làm việc với dữ liệu "thiết kế thế nào cũng được". Khi gặp vấn đề, người ta dựa vào năng lực của VBA để làm việc.

Loại 1 bị người ta khinh rể vì dùng công thức và mấy cái bảng Pivot nó không được "pờ rồ"
Loại 2 được trong vọng hơn, bởi vì chỉ cần hỏi và lấy giải đáp thôi

Theo kinh nghiệm của tôi, thì để tiết kiệm Quota tôi cần trả lời có trọng tâm vấn đề, nghĩa là:

- Trước tiên tải File, đọc tiêu đề cột, nội dung trong File và so sánh với nội dung yêu cầu của chủ Topic.

- Góp ý những vấn để cần sửa đổi, bổ sung hoặc thay đổi cấu trúc.

- Khi chủ Topic đã sửa đổi, bổ sung theo yêu cầu và kèm theo vài chục dòng dữ liệu thì lúc đó tôi mới tính đến chuyện giúp (chỉ trả lời 1 đến 2 lần là cao lắm rồi), chứ có nhiều bạn hỏi bâng quơ không cụ thể thì có trường hợp phải trả lời nhiều lần mất rất nhiều thời gian và tốn rất nhiều Quota không đáng có. Chính vì vậy mà thời gian gần đây tôi thường góp ý cho các bài viết như đã nêu trên.

Đối với nội dung bạn ấy hỏi, thì giải pháp như sau:

- Sử dụng Advanced Filter để trích lọc tên chủ hoặc số CMND.

- Sử dụng VBA để chuyển đổi dữ liệu cột số thửa cũ đồng thời chạy PivotTable (theo ý kiến của bạn) là có kết quả tổng số thửa của từng chủ sử dụng.

baquang1984 · 25/8/14

be09 đã viết:
Theo kinh nghiệm của tôi, thì để tiết kiệm Quota tôi cần trả lời có trọng tâm vấn đề, nghĩa là:

- Trước tiên tải File, đọc tiêu đề cột, nội dung trong File và so sánh với nội dung yêu cầu của chủ Topic.

- Góp ý những vấn để cần sửa đổi, bổ sung hoặc thay đổi cấu trúc.

- Khi chủ Topic đã sửa đổi, bổ sung theo yêu cầu và kèm theo vài chục dòng dữ liệu thì lúc đó tôi mới tính đến chuyện giúp (chỉ trả lời 1 đến 2 lần là cao lắm rồi), chứ có nhiều bạn hỏi bâng quơ không cụ thể thì có trường hợp phải trả lời nhiều lần mất rất nhiều thời gian và tốn rất nhiều Quota không đáng có. Chính vì vậy mà thời gian gần đây tôi thường góp ý cho các bài viết như đã nêu trên.

Đối với nội dung bạn ấy hỏi, thì giải pháp như sau:

- Sử dụng Advanced Filter để trích lọc tên chủ hoặc số CMND.

- Sử dụng VBA để chuyển đổi dữ liệu cột số thửa cũ đồng thời chạy PivotTable (theo ý kiến của bạn) là có kết quả tổng số thửa của từng chủ sử dụng.

Đối với chương trình và bảng biểu em đưa lên diễn đàn hỏi là để phục vụ cho công việc của em tránh tình trạng là em phải làm lại tùy theo từng chương trình do vậy anh thông cảm, đối với anh nó có thể không phù hợp nhưng của em thì em sử dụng cho mục đích của mình anh ạ. Em rất cả ơn anh be09 và mọi người trên diễn đàn giúp đỡ và đóng góp ý kiến ạ
EM cảm ơn mọi người nhiều!

sealand · 25/8/14

baquang1984 đã viết:
Em cảm ơn anh sealand dùng Pivot Table thì cũng được tuy nhiên một việc quan trong là Pivot Table không đếm được các Cell có dự liệu kiểu 157+158+159 như em mô tả ở bài #10. Do vây em muốn nhờ các thầy, cô, các anh, chị và các bạn giúp đỡ xử lý chương trình bằng VBA.
Em cảm ơn mọi người nhiều!

Trong file bạn gửi làm gì có dữ liệu dạng đó nhỉ?
Bạn không đề cập rõ ràng thì Code cũng chết như thường. Đây là điều kiện bắt buộc chứ lúc thì 157+158+159 lúc thì 157;158;159 thì sao mà tính?

baquang1984 · 25/8/14

sealand đã viết:
Trong file bạn gửi làm gì có dữ liệu dạng đó nhỉ?
Bạn không đề cập rõ ràng thì Code cũng chết như thường. Đây là điều kiện bắt buộc chứ lúc thì 157+158+159 lúc thì 157;158;159 thì sao mà tính?

Vâng em cảm ơn anh sealand! dữ liệu của em được quy định trong Sheets"DATA" là (157+158+159) công nối giữa các thửa là dấu "+" mong được sự giúp đỡ của anh sealand và mọi người trên diễn đàn

Ba Tê · 25/8/14

baquang1984 đã viết:
Đối với chương trình và bảng biểu em đưa lên diễn đàn hỏi là để phục vụ cho công việc của em tránh tình trạng là em phải làm lại tùy theo từng chương trình do vậy anh thông cảm, đối với anh nó có thể không phù hợp nhưng của em thì em sử dụng cho mục đích của mình anh ạ. Em rất cả ơn anh be09 và mọi người trên diễn đàn giúp đỡ và đóng góp ý kiến ạ
EM cảm ơn mọi người nhiều!

Đúng như các bạn trên đã nói. Bây giờ phải "gọt chân xỏ giày" chứ không phải "đo chân đóng giày" rồi.

baquang1984 · 25/8/14

Ba Tê đã viết:
Đúng như các bạn trên đã nói. Bây giờ phải "gọt chân xỏ giày" chứ không phải "đo chân đóng giày" rồi.

Em cảm ơn anh Ba Tê không thể nói gì hơn, chương trình thật là tuyệt với. Em có thể làm phiền anh thêm một chút nữa có được không ạ.
- Giờ em muốn lọc theo điều kiện từng thôn và theo từng mã có được không ạ, em thêm cột Ma ở Sheets"DATA", số của từng mã là (1, 2, 3) anh có thể sửa code cho em thêm chút có được không ạ, biết là không nói ngay từ đầu nên mong anh thông cảm giúp em được không ạ
+ Điều kiện lọc theo thôn là lấy theo thôn muốn lọc ở cột Diachi_ChuSD Sheets"DATA"
+ Điều kiện lọc theo mã là lấy theo cột Ma (Cột số 43) Sheets"DATA" theo các mã 1, 2, 3 (Ý nghĩa của các mã là: Mã 1 Đất nông nghiệp có thời hạn sử dụng là 20 năm, Mã 2 Đất trồng cây lâu năm có thời hạn sử dụng 50 năm, Mã 3 Đất ở nông thôn có thời hạn sử dụng lâu dai)
Em cảm ơn anh và các thành viên của diễn đàn đã giúp đỡ và đóng góp ý kiến!

Quang_Hải · 25/8/14

baquang1984 đã viết:
Em cảm ơn anh Ba Tê không thể nói gì hơn, chương trình thật là tuyệt với. Em có thể làm phiền anh thêm một chút nữa có được không ạ.
- Giờ em muốn lọc theo điều kiện từng thôn và theo từng mã có được không ạ, em thêm cột Ma ở Sheets"DATA", số của từng mã là (1, 2, 3) anh có thể sửa code cho em thêm chút có được không ạ, biết là không nói ngay từ đầu nên mong anh thông cảm giúp em được không ạ
+ Điều kiện lọc theo thôn là lấy theo thôn muốn lọc ở cột Diachi_ChuSD Sheets"DATA"
+ Điều kiện lọc theo mã là lấy theo cột Ma (Cột số 43) Sheets"DATA" theo các mã 1, 2, 3 (Ý nghĩa của các mã là: Mã 1 Đất nông nghiệp có thời hạn sử dụng là 20 năm, Mã 2 Đất trồng cây lâu năm có thời hạn sử dụng 50 năm, Mã 3 Đất ở nông thôn có thời hạn sử dụng lâu dai)
Em cảm ơn anh và các thành viên của diễn đàn đã giúp đỡ và đóng góp ý kiến!

Nói rồi mà không chịu tin. Mấy vụ này anh BaTê hay lắm.

baquang1984 đã viết:
Em cảm ơn anh Ba Tê không thể nói gì hơn, "chỉ có thể kêu anh sửa lại code thôi "

baquang1984 · 25/8/14

quanghai1969 đã viết:
Nói rồi mà không chịu tin. Mấy vụ này anh BaTê hay lắm.

Em cảm ơn QuangHai1969 không biết anh Ba Tê làm về màng gì, không biết anh có làm về công tác quản lý đất đai không nhỉ ???

Quang_Hải · 25/8/14

baquang1984 đã viết:
Em cảm ơn QuangHai1969 không biết anh Ba Tê làm về màng gì, không biết anh có làm về công tác quản lý đất đai không nhỉ ???

Nghề chính của anh Ba là giáo viên dạy võ. Nghề kế chính hình như là cò đất đai gì đó. Thôi zọt lẹ.

Ba Tê · 25/8/14

baquang1984 đã viết:
Em cảm ơn QuangHai1969 không biết anh Ba Tê làm về màng gì, không biết anh có làm về công tác quản lý đất đai không nhỉ ???

Mảng VBA thì mới học lóm trên GPE, còn làm mảng gì khác thì....
Híc! Cũng liên quan trực tiếp với đất đai, lúc nào cũng đụng đất đai, mình mẩy lúc nào cũng đất đai....mà không có một "cục đất chọi chim"

baquang1984 · 25/8/14

Ba Tê đã viết:
Mảng VBA thì mới học lóm trên GPE, còn làm mảng gì khác thì....
Híc! Cũng liên quan trực tiếp với đất đai, lúc nào cũng đụng đất đai, mình mẩy lúc nào cũng đất đai....mà không có một "cục đất

Bởi vì em làm về mang đất đai nên cảm thấy phức tạp quá anh Ba Tê ạ. Công tác thủ tục hành chính thì nhiêu khê, thay đổi liên tục. Anh giúp em với điều kiện lọc như em mô tả ở bài #25 được không ạ.
Cảm ơn anh nhiều!

baquang1984 · 25/8/14

quanghai1969 đã viết:
Nghề chính của anh Ba là giáo viên dạy võ. Nghề kế chính hình như là cò đất đai gì đó. Thôi zọt lẹ.

Em thấy anh Ba có giống người dạy võ đâu anh. Nếu mà có may mắn được cafe với các anh thì hay quà. Cái này chắc phải nhờ vào duyên vậy

Quang_Hải · 25/8/14

baquang1984 đã viết:
Nếu mà có may mắn được cafe với các anh thì hay quà. Cái này chắc phải nhờ vào duyên vậy

May mắn con khỉ khô gì chứ, duyên số quái gì. Muốn thì chạy xuống An Giang, hoặc lên Bình Dương, TP HCM thì có người tiếp liền.

baquang1984 đã viết:
Em thấy anh Ba có giống người dạy võ đâu anh

Nhìn thấy vậy đó, chứ ai đụng tới anh Ba biết liền

baquang1984 · 25/8/14

quanghai1969 đã viết:
May mắn con khỉ khô gì chứ, duyên số quái gì. Muốn thì chạy xuống An Giang, hoặc lên Bình Dương, TP HCM thì có người tiếp liền.

Hiiii em lại ở tỉnh Bắc Giang gần biên giới với ông bạn Trung Quốc còn vào và giao lưu với các anh thì phải hơn 2,5 h bay mới tới được chắc là phải tích lũy xiền vậy. Cũng mong được giao lưu với các anh
Thanks all!

Ba Tê · 25/8/14

baquang1984 đã viết:
Bởi vì em làm về mang đất đai nên cảm thấy phức tạp quá anh Ba Tê ạ. Công tác thủ tục hành chính thì nhiêu khê, thay đổi liên tục. Anh giúp em với điều kiện lọc như em mô tả ở bài #25 được không ạ.
Cảm ơn anh nhiều!

Thấy còn "đèn" cũng ráng sửa một chút xem sao. Hổng trúng thì mai tiếp, hổng chơi nữa à nghe.

baquang1984 · 25/8/14

Ba Tê đã viết:
Thấy còn "đèn" cũng ráng sửa một chút xem sao. Hổng trúng thì mai tiếp, hổng chơi nữa à nghe.

Em cảm ơn Ba Tê em cảm ơn các thành viên của diễn đàn.
Chúc cả nhà ngủ ngon "đèn" giờ này chắc cũng tắt hết rồi

be_09 · 26/8/14

baquang1984 đã viết:
Em cảm ơn anh Ba Tê không thể nói gì hơn, chương trình thật là tuyệt với. Em có thể làm phiền anh thêm một chút nữa có được không ạ.
- Giờ em muốn lọc theo điều kiện từng thôn và theo từng mã có được không ạ, em thêm cột Ma ở Sheets"DATA", số của từng mã là (1, 2, 3) anh có thể sửa code cho em thêm chút có được không ạ, biết là không nói ngay từ đầu nên mong anh thông cảm giúp em được không ạ
+ Điều kiện lọc theo thôn là lấy theo thôn muốn lọc ở cột Diachi_ChuSD Sheets"DATA"
+ Điều kiện lọc theo mã là lấy theo cột Ma (Cột số 43) Sheets"DATA" theo các mã 1, 2, 3 (Ý nghĩa của các mã là: Mã 1 Đất nông nghiệp có thời hạn sử dụng là 20 năm, Mã 2 Đất trồng cây lâu năm có thời hạn sử dụng 50 năm, Mã 3 Đất ở nông thôn có thời hạn sử dụng lâu dai)
Em cảm ơn anh và các thành viên của diễn đàn đã giúp đỡ và đóng góp ý kiến!

Còn gì nữa thì thêm cho đầy đủ tôi sẽ giúp cho tất tần tật 1 lần, chứ đối với những File có dung lượng lớn và cái vụ thêm thêm này thì tôi rất ngán ngại trả lời, vì Quota của tôi cũng có giới hạn.

Còn nghề địa chính chính thì khỏi phải bàn, tôi đã có 37 năm trong nghề, nói để bạn hiểu là tất cả các thứ bạn làm tôi đều đã kinh qua hết rồi, chính vì vậy ngay lần đầu tiên nhìn File là tôi đã biết bạn cần gì.

Theo gợi ý của tôi ban đầu là chỉ cần dùng 1 sheet theo dõi tất tần tật các thứ như: đăng ký, chưa đăng ký, chưa xét duyệt đơn, đã xét duyệt đơn theo từng đợt, theo dõi tờ trình phòng Tài nguyên và môi trường, theo dõi đợt trình UBND huyện, theo dõi số thửa đã cấp giấy, số giấy theo từng đợt, số thửa chưa cấp giấy, cuối cùng là phần tổng hợp và trích lọc dữ liệu theo từng loại cũng chỉ dựa vào 1 với sheet dữ liệu duy nhất.

Tôi cũng đã từng kiểm tra anh em cấp huyện làm mảng này, thường thì anh em theo dõi mỗi đợt là 1 sheet, nếu trình vài trăm đợt thì theo dõi vài trăm sheet à, như vậy làm sao theo dõi và làm sao cho thuận tiện trong việc tổng hợp, tôi thấy làm kiểu này rất khó theo dõi và tổng hợp mất rất nhiều thời gian và số liệu cũng không đãm bảo chính xác (vì 1 giấy có thể trình nhiều lần, mỗi lần là 1 danh sách).

baquang1984 · 26/8/14

be09 đã viết:
Còn gì nữa thì thêm cho đầy đủ tôi sẽ giúp cho tất tần tật 1 lần, chứ đối với những File có dung lượng lớn và cái vụ thêm thêm này thì tôi rất ngán ngại trả lời, vì Quota của tôi cũng có giới hạn.

Còn nghề địa chính chính thì khỏi phải bàn, tôi đã có 37 năm trong nghề, nói để bạn hiểu là tất cả các thứ bạn làm tôi đều đã kinh qua hết rồi, chính vì vậy ngay lần đầu tiên nhìn File là tôi đã biết bạn cần gì.

Theo gợi ý của tôi ban đầu là chỉ cần dùng 1 sheet theo dõi tất tần tật các thứ như: đăng ký, chưa đăng ký, chưa xét duyệt đơn, đã xét duyệt đơn theo từng đợt, theo dõi tờ trình phòng Tài nguyên và môi trường, theo dõi đợt trình UBND huyện, theo dõi số thửa đã cấp giấy, số giấy theo từng đợt, số thửa chưa cấp giấy, cuối cùng là phần tổng hợp và trích lọc dữ liệu theo từng loại cũng chỉ dựa vào 1 với sheet dữ liệu duy nhất.

Tôi cũng đã từng kiểm tra anh em cấp huyện làm mảng này, thường thì anh em theo dõi mỗi đợt là 1 sheet, nếu trình vài trăm đợt thì theo dõi vài trăm sheet à, như vậy làm sao theo dõi và làm sao cho thuận tiện trong việc tổng hợp, tôi thấy làm kiểu này rất khó theo dõi và tổng hợp mất rất nhiều thời gian và số liệu cũng không đãm bảo chính xác (vì 1 giấy có thể trình nhiều lần, mỗi lần là 1 danh sách).

Em cảm ơn anh be09 đã góp ý và giúp đỡ cho vấn đề em đang gặp phải, dữ liệu và các cột bố trí của em chỉ có vậy thôi và yêu cầu thì cũng đã trình bày ở bài #1, #10 và #25 rồi. Được các anh nhiệt tình giúp đỡ em cảm ơn mọi người nhiều!

baquang1984 · 26/8/14

Ba Tê đã viết:
Thấy còn "đèn" cũng ráng sửa một chút xem sao. Hổng trúng thì mai tiếp, hổng chơi nữa à nghe.

Anh Ba Tê có thể cho em hỏi chút là khi lọc dữ liệu sang Sheets"TONGHOP" thì ở các cột 12, 13 và 15, 16 trong dữ liệu được lọc sang
Anh viết tắt từ Tờ BĐ là 1 thửa, 2 thưa ở các cột 12 và 15, 1 Tờ BĐ, 2 Tờ BĐ ở các cột 13 và 16. Giờ em muốn sửa Code của anh để chương trình viết thành Tờ bản đồ thì phải làm thế nào ạ
Em cảm ơn anh!

be_09 · 26/8/14

baquang1984 đã viết:
Em cảm ơn anh be09 đã góp ý và giúp đỡ cho vấn đề em đang gặp phải, dữ liệu và các cột bố trí của em chỉ có vậy thôi và yêu cầu thì cũng đã trình bày ở bài #1, #10 và #25 rồi. Được các anh nhiệt tình giúp đỡ em cảm ơn mọi người nhiều!

Bạn cần tham khảo thêm cách tôi làm với File đính kèm ở bài #23 của Topic sau để hiểu thêm về những cái cần tổng hợp và nêu thêm cần tổng hợp những cái gì (ví dụ: tổng hợp diện tích cấp giấy với từng bản theo loại đất, với tổng thửa và tổng diện tích hoặc tổng hợp theo từng tờ bản đồ..v...v.....)? Tôi rảnh sẽ làm giúp cho bạn hoàn chỉnh sau.

http://www.giaiphapexcel.com/forum/...n-trợ-giúp-về-thống-kê-và-lọc-dữ-liệu-!/page3

Ba Tê · 26/8/14

baquang1984 đã viết:
Anh Ba Tê có thể cho em hỏi chút là khi lọc dữ liệu sang Sheets"TONGHOP" thì ở các cột 12, 13 và 15, 16 trong dữ liệu được lọc sang
Anh viết tắt từ Tờ BĐ là 1 thửa, 2 thưa ở các cột 12 và 15, 1 Tờ BĐ, 2 Tờ BĐ ở các cột 13 và 16. Giờ em muốn sửa Code của anh để chương trình viết thành Tờ bản đồ thì phải làm thế nào ạ
Em cảm ơn anh!

Trong các cột 12 -> 17 làm gì có thửa, hay Tờ BĐ. Bạn chọn 1 ô trong đó rồi nhìn trên thanh công thức xem, code chỉ ghi ra các con số thôi.
Chuyện khác vào Format Cells mà chỉnh. Bạn muốn con số 9 trong ô nhưng khi hiện trên màn hình là "vàng bốn số 9" cũng được mà.
Híc!

baquang1984 · 26/8/14

Ba Tê đã viết:
Trong các cột 12 -> 17 làm gì có thửa, hay Tờ BĐ. Bạn chọn 1 ô trong đó rồi nhìn trên thanh công thức xem, code chỉ ghi ra các con số thôi.
Chuyện khác vào Format Cells mà chỉnh. Bạn muốn con số 9 trong ô nhưng khi hiện trên màn hình là "vàng bốn số 9" cũng được mà.
Híc!

Vâng em cảm ơn anh, em tìm mãi mà không được, là do bác định dạng trong Format Cells. Trình độ sử dụng excel của em còn gà quá

baquang1984 · 26/8/14

be09 đã viết:
Bạn cần tham khảo thêm cách tôi làm với File đính kèm ở bài #23 của Topic sau để hiểu thêm về những cái cần tổng hợp và nêu thêm cần tổng hợp những cái gì (ví dụ: tổng hợp diện tích cấp giấy với từng bản theo loại đất, với tổng thửa và tổng diện tích hoặc tổng hợp theo từng tờ bản đồ..v...v.....)? Tôi rảnh sẽ làm giúp cho bạn hoàn chỉnh sau.

http://www.giaiphapexcel.com/forum/...n-trợ-giúp-về-thống-kê-và-lọc-dữ-liệu-!/page3

Chương trình của anh hay quá, cách bố trí các trang tính như thế này tiện trong công tác thao tạc với dữ liệu và di chuyển nhanh giữa các Sheets.
thật là khoa học. Diễn đàn quả là nhiều các bậc tiền bối!
Em cảm ơn anh đã giúp đỡ, em chúc anh và gia đình sức khỏe!

sealand · 26/8/14

Em xin mạn phép tham gia với Code của anh BaTe và chủ Topic:

1/Để có thể linh hoạt trong việc đếm số thửa, số tờ bản đồ khi dữ liệu thục tế có thể rất động về cách viết (Ví dụ 45+46 hay 45/46 hay 45&46 v.v...Cũng như loại bỏ việc đếm nhầm các dấu nối ở đầu hay cuối như +55 chẳng hạn) và có thể sử dụng nhiều lần (Vì co tới 4 cột áp dụng cách đếm này) ta nên xây dựng 1 hàm Thư viện như sau:

Mã:

Function MCount(ByVal Vl As String) As Integer
Dim Kt As Boolean, StrTest As String, Tm, x
Vl = Trim(Vl)
StrTest = "+~/~\~-~;~,~.~*~&~^~%"
Do
If Vl = "" Then
Exit Function
ElseIf InStr(1, StrTest, Left(Vl, 1)) > 0 Then
Vl = Right(Vl, Len(Vl) - 1)
ElseIf InStr(1, Right(Vl, 1)) > 0 Then
Vl = Left(Vl, Len(Vl) - 1)
Else
Kt = True
End If
Loop Until Kt
Tm = Split(StrTest, "~")
For x = LBound(Tm) To UBound(Tm)
If InStr(1, Vl, Tm(x)) > 0 Then
MCount = MCount + Len(Vl) - Len(Replace(Vl, Tm(x), ""))
End If
Next
MCount = MCount + 1
End Function

2/Trong Code chính nên viết cho gọn dễ kiểm soát hơn, mệnh đề With...end with chẳng hạn. Chỉ vì tránh 3 chỗ viết tên Sheet mà lại thêm 2 dòng lệnh. Biến Tem cũng vậy, nếu dùng ít ta gán luôn khỏi dùng biến trung gian.
Với Hàm trên em xin phép Modify Code của bác như sau:

Mã:

Sub GPExyz()
Dim Dic As Object, sArr(), dArr(), Col(), I As Long, J As Long, K As Long, GPE, Id
Dim DKThon As String, DKMa As Long
Set Dic = CreateObject("Scripting.Dictionary")
DKThon = UCase(Sheets("TONGHOP").[B2])
DKMa = Sheets("TONGHOP").[E2].Value
    sArr = Sheets("Data").Range(Sheets("Data").[A3], Sheets("Data").[A3].End(xlDown)).Resize(, 44).Value
For I = 1 To UBound(sArr, 1)
  [COLOR=#008080][I]'Kiem tra neu dung Thon va CMND thi thuc hien 2 viec sau[/I][/COLOR]
    If UCase(sArr(I, 3)) = DKThon And sArr(I, 44) = DKMa Then
           [COLOR=#008080][I] 'Neu trong Danh sach chua co thi Bo xung vao Danh sach[/I][/COLOR]
            If Not Dic.Exists(sArr(I, 5)) Then
            K = K + 1
            Dic.Add sArr(I, 5), K
            ReDim Preserve dArr(1 To 17, 1 To K)
            For J = 1 To 11
            dArr(J, K) = sArr(I, J + 1)
            Next
            End If
            [I][COLOR=#008080]'Tong hop du lieu vao Danh sach[/COLOR][/I]
            Id = Dic.Item(sArr(I, 5))
            dArr(12, Id) = dArr(12, Id) + MCount(sArr(I, 13))
            dArr(13, Id) = dArr(13, Id) + MCount(sArr(I, 14))
            dArr(14, Id) = dArr(14, Id) + sArr(I, 15)
            dArr(15, Id) = dArr(15, Id) + MCount(sArr(I, 28))
            dArr(16, Id) = dArr(16, Id) + MCount(sArr(I, 29))
            dArr(17, Id) = dArr(17, Id) + sArr(I, 30)
    End If
  Next
With Sheets("TONGHOP")
    .[A5:A1000].Resize(, 17).ClearContents
    If K Then .[A5].Resize(K, 17).Value = WorksheetFunction.Transpose(dArr)
End With
End Sub

Như vậy, Code của bác giờ gọn gàng và dễ kiểm soát hơn nhiều.(Em chưa Test nhưng có thể tốc độ cũng cao hơn)
Bác BaTe thông cảm nha

baquang1984 · 26/8/14

sealand đã viết:
Em xin mạn phép tham gia với Code của anh BaTe và chủ Topic:

1/Để có thể linh hoạt trong việc đếm số thửa, số tờ bản đồ khi dữ liệu thục tế có thể rất động về cách viết (Ví dụ 45+46 hay 45/46 hay 45&46 v.v...Cũng như loại bỏ việc đếm nhầm các dấu nối ở đầu hay cuối như +55 chẳng hạn) và có thể sử dụng nhiều lần (Vì co tới 4 cột áp dụng cách đếm này) ta nên xây dựng 1 hàm Thư viện như sau:

Mã:

Function MCount(ByVal Vl As String) As Integer Dim Kt As Boolean, StrTest As String, Tm, x Vl = Trim(Vl) StrTest = "+~/~\~-~;~,~.~*~&~^~%" Do If Vl = "" Then Exit Function ElseIf InStr(1, StrTest, Left(Vl, 1)) > 0 Then Vl = Right(Vl, Len(Vl) - 1) ElseIf InStr(1, Right(Vl, 1)) > 0 Then Vl = Left(Vl, Len(Vl) - 1) Else Kt = True End If Loop Until Kt Tm = Split(StrTest, "~") For x = LBound(Tm) To UBound(Tm) If InStr(1, Vl, Tm(x)) > 0 Then MCount = MCount + Len(Vl) - Len(Replace(Vl, Tm(x), "")) End If Next MCount = MCount + 1 End Function

2/Trong Code chính nên viết cho gọn dễ kiểm soát hơn, mệnh đề With...end with chẳng hạn. Chỉ vì tránh 3 chỗ viết tên Sheet mà lại thêm 2 dòng lệnh. Biến Tem cũng vậy, nếu dùng ít ta gán luôn khỏi dùng biến trung gian.
Với Hàm trên em xin phép Modify Code của bác như sau:

Mã:

Sub GPExyz() Dim Dic As Object, sArr(), dArr(), Col(), I As Long, J As Long, K As Long, GPE, Id Dim DKThon As String, DKMa As Long Set Dic = CreateObject("Scripting.Dictionary") DKThon = UCase(Sheets("TONGHOP").[B2]) DKMa = Sheets("TONGHOP").[E2].Value sArr = Sheets("Data").Range(Sheets("Data").[A3], Sheets("Data").[A3].End(xlDown)).Resize(, 44).Value For I = 1 To UBound(sArr, 1) [COLOR=#008080][I]'Kiem tra neu dung Thon va CMND thi thuc hien 2 viec sau[/I][/COLOR] If UCase(sArr(I, 3)) = DKThon And sArr(I, 44) = DKMa Then [COLOR=#008080][I] 'Neu trong Danh sach chua co thi Bo xung vao Danh sach[/I][/COLOR] If Not Dic.Exists(sArr(I, 5)) Then K = K + 1 Dic.Add sArr(I, 5), K ReDim Preserve dArr(1 To 17, 1 To K) For J = 1 To 11 dArr(J, K) = sArr(I, J + 1) Next End If [I][COLOR=#008080]'Tong hop du lieu vao Danh sach[/COLOR][/I] Id = Dic.Item(sArr(I, 5)) dArr(12, Id) = dArr(12, Id) + MCount(sArr(I, 13)) dArr(13, Id) = dArr(13, Id) + MCount(sArr(I, 14)) dArr(14, Id) = dArr(14, Id) + sArr(I, 15) dArr(15, Id) = dArr(15, Id) + MCount(sArr(I, 28)) dArr(16, Id) = dArr(16, Id) + MCount(sArr(I, 29)) dArr(17, Id) = dArr(17, Id) + sArr(I, 30) End If Next With Sheets("TONGHOP") .[A5:A1000].Resize(, 17).ClearContents If K Then .[A5].Resize(K, 17).Value = WorksheetFunction.Transpose(dArr) End With End Sub

Như vậy, Code của bác giờ gọn gàng và dễ kiểm soát hơn nhiều.(Em chưa Test nhưng có thể tốc độ cũng cao hơn)
Bác BaTe thông cảm nha

Cảm ơn anh vậy để áp dụng hàm thư viện của anh vào với code của bác góp ý thì dùng thế nào ạ

sealand · 26/8/14

Thì cứ chép chung nó vào 1 Module là OK

baquang1984 · 27/8/14

Ba Tê đã viết:
Thấy còn "đèn" cũng ráng sửa một chút xem sao. Hổng trúng thì mai tiếp, hổng chơi nữa à nghe.

Anh Ba Tê và các thành viên trên diễn đàn cho em làm phiển các thành viên thêm chút nữa là
Khi lọc dữ liệu sang Sheets"TONGHOP" thì dữ liệu tại các cột 12, 13 và 15, 16, 18, 19, 20 dữ liệu sẽ được ghi ra như sau ạ:
- Nếu Chủ quản lý nào (CMND1) có 1 thửa ở cột 12 Sheets"TONGHOP" thì Cột 12 sẽ ghi luôn số thửa tìm được, cột 13 ghi luôn số tờ bản đồ tìm được bên Sheets"DATA".
- Nếu Chủ quản lý nào (CMND1) có 2 thửa trở lên ở cột 12 Sheets"TONGHOP" thì Cột 12 sẽ ghi số thửa đếm được + chữ "thửa" (VD 2 thửa), cột 13 ghi số tờ bản đồ đếm được + chữ "tờ bản đồ" (VD 1 tờ bản đồ)
- Nếu Chủ quản lý nào (CMND1) có 1 thửa ở cột 16 Sheets"TONGHOP" thì Cột 16 sẽ ghi luôn số thửa tìm được, cột 15 ghi luôn số tờ bản đồ tìm được, cột 18 ghi SO_GCNcu, cột 19 ghi NGAY_CAPcu, cột 20 ghi MDSDcu với dữ liệu tìm được tại các cột 28, 29, 31, 32, 33 bên Sheets"DATA"
- Nếu chủ quản lý nào (CMND1) cột 16 Sheets"TONGHOP" có 2 thửa trở lên thì Cột 16 sẽ ghi số thửa đếm được + chữ "thửa" (VD 2 thửa), cột 15 ghi số tờ bản đồ đếm được + chữ "tờ bản đồ" (VD 1 tờ bản đồ) còn các cột 18, 19, 20 không thể hiện thông tin
giúp em thêm lấy thông tin vào 2 cột giới tính 1, giới tính 2 Sheets"TONGHOP"
Em cảm ơn anh và các thành viên của diễn đàn!

sealand · 27/8/14

Bạn thay Code này vào Code cũ:

Mã:

Sub GPExyz()
Dim Dic As Object, sArr(), dArr(), Col(), I As Long, J As Long, k As Long, GPE, Id
Dim DKThon As String, DKMa As Long
Set Dic = CreateObject("Scripting.Dictionary")
DKThon = UCase(Sheets("TONGHOP").[B2])
DKMa = Sheets("TONGHOP").[E2].Value
    sArr = Sheets("Data").Range(Sheets("Data").[A3], Sheets("Data").[A3].End(xlDown)).Resize(, 44).Value
For I = 1 To UBound(sArr, 1)
    'Kiem tra neu dung Thon va CMND thi thuc hien 2 viec sau
    If UCase(sArr(I, 3)) = DKThon And sArr(I, 44) = DKMa Then
            'Neu trong Danh sach chua co thi Bo xung vao Danh sach
            If Not Dic.Exists(sArr(I, 5)) Then
            k = k + 1
            Dic.Add sArr(I, 5), k
            ReDim Preserve dArr(1 To 17, 1 To k)
            For J = 1 To 11
            dArr(J, k) = sArr(I, J + 1)
            Next
            End If
            'Tong hop du lieu vao Danh sach
            Id = Dic.Item(sArr(I, 5))
            dArr(12, Id) = dArr(12, Id) & IIf(dArr(12, Id) <> "", "+", "") & sArr(I, 13)
            dArr(13, Id) = dArr(13, Id) & IIf(dArr(13, Id) <> "", "+", "") & sArr(I, 14)
            dArr(14, Id) = dArr(14, Id) + sArr(I, 15)
            dArr(15, Id) = dArr(15, Id) & IIf(dArr(15, Id) <> "", "+", "") & sArr(I, 28)
            dArr(16, Id) = dArr(16, Id) & IIf(dArr(16, Id) <> "", "+", "") & sArr(I, 29)
            dArr(17, Id) = dArr(17, Id) + sArr(I, 30)
    End If
  Next
  For I = 1 To UBound(dArr, 2)
  dArr(12, I) = IIf(MCount(dArr(12, I)) = 1, "Th" & ChrW(7917) & "a s" & ChrW(7889) & ":  " & dArr(12, I), _
  IIf(MCount(dArr(12, I)) = 0, "", "C" & ChrW(7897) & "ng th" & ChrW(7917) & "a: " & MCount(dArr(12, I))))
  
  dArr(13, I) = IIf(MCount(dArr(13, I)) = 1, "B" & ChrW(7843) & "n " & ChrW(273) & ChrW(7891) & " s" & ChrW(7889) & ": " & dArr(13, I), _
  IIf(MCount(dArr(13, I)) = 0, "", "S" & ChrW(7889) & " t" & ChrW(7901) & " BD: " & MCount(dArr(13, I))))
  
  dArr(15, I) = IIf(MCount(dArr(15, I)) = 1, "B" & ChrW(7843) & "n " & ChrW(273) & ChrW(7891) & " s" & ChrW(7889) & ": " & dArr(15, I), _
  IIf(MCount(dArr(15, I)) = 0, "", "S" & ChrW(7889) & " t" & ChrW(7901) & " BD: " & MCount(dArr(15, I))))
  
  dArr(16, I) = IIf(MCount(dArr(16, I)) = 1, "Th" & ChrW(7917) & "a s" & ChrW(7889) & ": " & dArr(16, I), _
  IIf(MCount(dArr(16, I)) = 0, "", "C" & ChrW(7897) & "ng th" & ChrW(7917) & "a: " & MCount(dArr(16, I))))
  Next
  
With Sheets("TONGHOP")
    .[A5:A1000].Resize(, 17).ClearContents
    If k Then .[A5].Resize(k, 17).Value = WorksheetFunction.Transpose(dArr)
End With
End Sub

sealand · 27/8/14

Mình kiểm tra lại và code như sau mới đúng yêu cầu của bạn

Mã:

Sub GPExyz()
Dim Dic As Object, sArr(), dArr(), Col(), I As Long, J As Long, k As Long, GPE, Id
Dim DKThon As String, DKMa As Long
................................................................
  For I = 1 To UBound(dArr, 2)
  dArr(12, I) = IIf(MCount(dArr(12, I)) = 1, dArr(12, I), _
  IIf(MCount(dArr(12, I)) = 0, "", MCount(dArr(12, I)) & " th" & ChrW(7917) & "a"))
  
  dArr(13, I) = IIf(MCount(dArr(13, I)) = 1, dArr(13, I), _
  IIf(MCount(dArr(13, I)) = 0, "", MCount(dArr(13, I)) & " t" & ChrW(7901) & " b" & ChrW(7843) & "n " & ChrW(273) & ChrW(7891)))
  
  dArr(15, I) = IIf(MCount(dArr(15, I)) = 1, dArr(15, I), _
  IIf(MCount(dArr(15, I)) = 0, "", MCount(dArr(15, I)) & " t" & ChrW(7901) & " b" & ChrW(7843) & "n " & ChrW(273) & ChrW(7891)))
  
  dArr(16, I) = IIf(MCount(dArr(16, I)) = 1, dArr(16, I), _
  IIf(MCount(dArr(16, I)) = 0, "", MCount(dArr(16, I)) & " th" & ChrW(7917) & "a"))
  Next
.................................................
End Sub

baquang1984 · 27/8/14

sealand đã viết:

Mình kiểm tra lại và code như sau mới đúng yêu cầu của bạn

Mã:

Sub GPExyz()
Dim Dic As Object, sArr(), dArr(), Col(), I As Long, J As Long, k As Long, GPE, Id
Dim DKThon As String, DKMa As Long
................................................................
  For I = 1 To UBound(dArr, 2)
  dArr(12, I) = IIf(MCount(dArr(12, I)) = 1, dArr(12, I), _
  IIf(MCount(dArr(12, I)) = 0, "", MCount(dArr(12, I)) & " th" & ChrW(7917) & "a"))
  
  dArr(13, I) = IIf(MCount(dArr(13, I)) = 1, dArr(13, I), _
  IIf(MCount(dArr(13, I)) = 0, "", MCount(dArr(13, I)) & " t" & ChrW(7901) & " b" & ChrW(7843) & "n " & ChrW(273) & ChrW(7891)))
  
  dArr(15, I) = IIf(MCount(dArr(15, I)) = 1, dArr(15, I), _
  IIf(MCount(dArr(15, I)) = 0, "", MCount(dArr(15, I)) & " t" & ChrW(7901) & " b" & ChrW(7843) & "n " & ChrW(273) & ChrW(7891)))
  
  dArr(16, I) = IIf(MCount(dArr(16, I)) = 1, dArr(16, I), _
  IIf(MCount(dArr(16, I)) = 0, "", MCount(dArr(16, I)) & " th" & ChrW(7917) & "a"))
  Next
.................................................
End Sub

Em kiểm tra thì ở Cột 12, 13 và 15, 16 kết quản ra không được chuẩn anh ạ, chẳng hạn như em lọc Thôn Khuổi Phầy, Mã bằng 3
CQL Mã Ngọc Bằng ở Sheets"DATA" có số thửa ở cột 29 là 1 thửa (Thửa số 1) cột 28 không có tờ bản đồ, khi lọc sang Sheets"TONGHOP" thì cả 2 cột 15, 16 đều không có thông tin, đúng của yêu cầu chương trình ghi ở Côt 15 không ghi gì, cột 16 ghi số 1.
em lọc Thôn Khuổi Phầy, Mã bằng 2 thì CQL Mã Ngọc Bằng ở Sheets"DATA" có số thửa ở cột 13 là 4 thửa cột 14 có 2 tờ bản đồ là (Tờ số 5 và số 6), khi lọc sang Sheets"TONGHOP" thì cột 12 đúng 4 thửa, cột 13 chưa đúng, đúng yêu cầu của chương trình ghi ở Côt 12 ghi là 4 thửa, cột 13 ghi 2 tờ bản đồ.
Anh kiểm tra lại giúp em với ạ
Anh có thể cho hiển thị thông tin thêm cho em như em mô tả ở #46 được không anh. Còn các cột [TABLE="width: 464"]
[TR]
[TD="class: xl67, width: 86"]SO_GCNcu[/TD]
[TD="class: xl68, width: 107"]NGAY_CAPcu[/TD]
[TD="class: xl67, width: 71"]MDSDcu[/TD]
[TD="class: xl67, width: 100"]GIOI_TINH1[/TD]
[TD="class: xl67, width: 100"]GIOI_TINH2[/TD]
[/TR]
[/TABLE]
Em cảm ơn anh!

Ba Tê · 27/8/14

baquang1984 đã viết:
Anh Ba Tê và các thành viên trên diễn đàn cho em làm phiển các thành viên thêm chút nữa là
Khi lọc dữ liệu sang Sheets"TONGHOP" thì dữ liệu tại các cột 12, 13 và 15, 16, 18, 19, 20 dữ liệu sẽ được ghi ra như sau ạ:
- Nếu Chủ quản lý nào (CMND1) có 1 thửa ở cột 12 Sheets"TONGHOP" thì Cột 12 sẽ ghi luôn số thửa tìm được, cột 13 ghi luôn số tờ bản đồ tìm được bên Sheets"DATA".
- Nếu Chủ quản lý nào (CMND1) có 2 thửa trở lên ở cột 12 Sheets"TONGHOP" thì Cột 12 sẽ ghi số thửa đếm được + chữ "thửa" (VD 2 thửa), cột 13 ghi số tờ bản đồ đếm được + chữ "tờ bản đồ" (VD 1 tờ bản đồ)
- Nếu Chủ quản lý nào (CMND1) có 1 thửa ở cột 16 Sheets"TONGHOP" thì Cột 16 sẽ ghi luôn số thửa tìm được, cột 15 ghi luôn số tờ bản đồ tìm được, cột 18 ghi SO_GCNcu, cột 19 ghi NGAY_CAPcu, cột 20 ghi MDSDcu với dữ liệu tìm được tại các cột 28, 29, 31, 32, 33 bên Sheets"DATA"
- Nếu chủ quản lý nào (CMND1) cột 16 Sheets"TONGHOP" có 2 thửa trở lên thì Cột 16 sẽ ghi số thửa đếm được + chữ "thửa" (VD 2 thửa), cột 15 ghi số tờ bản đồ đếm được + chữ "tờ bản đồ" (VD 1 tờ bản đồ) còn các cột 18, 19, 20 không thể hiện thông tin
giúp em thêm lấy thông tin vào 2 cột giới tính 1, giới tính 2 Sheets"TONGHOP"
Em cảm ơn anh và các thành viên của diễn đàn!

Đã lỡ có "dính" với topic này rồi, dù là code có "bèo nhèo", "nhăn nheo", không gọn gàng, khó chỉnh sửa.
HY vọng là xài tạm được.
Híc!

cho em làm phiển các thành viên thêm chút nữa

Hổng dám chút đâu! "Điếc con mắt" luôn.

baquang1984 · 27/8/14

Ba Tê đã viết:
Đã lỡ có "dính" với topic này rồi, dù là code có "bèo nhèo", "nhăn nheo", không gọn gàng, khó chỉnh sửa.
HY vọng là xài tạm được.
Híc!

Hổng dám chút đâu! "Điếc con mắt" luôn.

Hixxx bác vui tính quá với chương trình kiều như thế này thì đối với anh chỉ là chuyện nhỏ mà
Cảm ơn anh nhiều!

sealand · 27/8/14

Bạn bổ xung 1 dòng sau vào Hàm đếm nha

Mã:

Function MCount(ByVal Vl As String) As Integer
Dim Kt As Boolean, StrTest As String, Tm, x
[B][COLOR=#ff0000]If IsNumeric(Vl) Then Vl = "m" & Vl[/COLOR][/B]
Vl = Trim(Vl)

StrTest = "+~/~\~-~;~,~.~*~&~^~%"
Do
If Vl = "" Then
Exit Function
ElseIf InStr(1, StrTest, Left(Vl, 1)) > 0 Then
Vl = Right(Vl, Len(Vl) - 1)
ElseIf InStr(1, Right(Vl, 1)) > 0 Then
Vl = Left(Vl, Len(Vl) - 1)
Else
Kt = True
End If
Loop Until Kt
Tm = Split(StrTest, "~")
For x = LBound(Tm) To UBound(Tm)
If InStr(1, Vl, Tm(x)) > 0 Then
MCount = MCount + Len(Vl) - Len(Replace(Vl, Tm(x), ""))
End If
Next
MCount = MCount + 1
End Function

baquang1984 · 27/8/14

Ba Tê đã viết:
Đã lỡ có "dính" với topic này rồi, dù là code có "bèo nhèo", "nhăn nheo", không gọn gàng, khó chỉnh sửa.
HY vọng là xài tạm được.
Híc!

Hổng dám chút đâu! "Điếc con mắt" luôn.

Anh Ba Tê ạ không ổn anh ơi, khi em lọc dữ liệu sang Sheets"TONGHOP" thì ở cột 12 có 1 thửa thì không ghi thửa tim được bên Sheets"DATA" mà toàn ghi là 1 thôi hixx
Anh kiểm tra lại giúp em với ạ!

baquang1984 · 27/8/14

sealand đã viết:

Bạn bổ xung 1 dòng sau vào Hàm đếm nha

Mã:

Function MCount(ByVal Vl As String) As Integer
Dim Kt As Boolean, StrTest As String, Tm, x
[B][COLOR=#ff0000]If IsNumeric(Vl) Then Vl = "m" & Vl[/COLOR][/B]
Vl = Trim(Vl)

StrTest = "+~/~\~-~;~,~.~*~&~^~%"
Do
If Vl = "" Then
Exit Function
ElseIf InStr(1, StrTest, Left(Vl, 1)) > 0 Then
Vl = Right(Vl, Len(Vl) - 1)
ElseIf InStr(1, Right(Vl, 1)) > 0 Then
Vl = Left(Vl, Len(Vl) - 1)
Else
Kt = True
End If
Loop Until Kt
Tm = Split(StrTest, "~")
For x = LBound(Tm) To UBound(Tm)
If InStr(1, Vl, Tm(x)) > 0 Then
MCount = MCount + Len(Vl) - Len(Replace(Vl, Tm(x), ""))
End If
Next
MCount = MCount + 1
End Function

Phần này cũng chưa được anh ạ!
em lọc Thôn Khuổi Phầy, Mã bằng 2 thì CQL Mã Ngọc Bằng ở Sheets"DATA" có số thửa ở cột 13 là 4 thửa cột 14 có 2 tờ bản đồ là (Tờ số 5 và số 6), khi lọc sang Sheets"TONGHOP" thì cột 12 đúng 4 thửa, cột 13 chưa đúng, đúng yêu cầu của chương trình ghi ở Côt 12 ghi là 4 thửa, cột 13 ghi 2 tờ bản đồ.
Anh kiểm tra lại giúp em với ạ
Anh có thể cho hiển thị thông tin thêm cho em như em mô tả ở #46 được không anh. Còn các cột[TABLE="class: cms_table, width: 464"]
[TR]
[TD="class: cms_table_xl67, width: 86"]SO_GCNcu[/TD]
[TD="class: cms_table_xl68, width: 107"]NGAY_CAPcu[/TD]
[TD="class: cms_table_xl67, width: 71"]MDSDcu[/TD]
[TD="class: cms_table_xl67, width: 100"]GIOI_TINH1[/TD]
[TD="class: cms_table_xl67, width: 100"]GIOI_TINH2[/TD]
[/TR]
[/TABLE]

Em cảm ơn anh!

Ba Tê · 27/8/14

baquang1984 đã viết:
Anh Ba Tê ạ không ổn anh ơi, khi em lọc dữ liệu sang Sheets"TONGHOP" thì ở cột 12 có 1 thửa thì không ghi thửa tim được bên Sheets"DATA" mà toàn ghi là 1 thôi hixx
Anh kiểm tra lại giúp em với ạ!

Cột 12 sai do chưa "giải quyết nó", Nhiều chuyện lu bu nên sót lại cột 12.
Tải file này về, chép 3 Sub trong Module thay cho tất cả các sub cũ.
Đưa ra đôi giày, "đẽo" riết rồi cái chân sưng vù mà chưa biết "nhét" vào chiếc giày đựợc không.
Híc!

baquang1984 · 27/8/14

Ba Tê đã viết:
Cột 12 sai do chưa "giải quyết nó", Nhiều chuyện lu bu nên sót lại cột 12.
Tải file này về, chép 3 Sub trong Module thay cho tất cả các sub cũ.
Đưa ra đôi giày, "đẽo" riết rồi cái chân sưng vù mà chưa biết "nhét" vào chiếc giày đựợc không.
Híc!

Anh Ba Tê em kiêm tra chương trình thì ở cột 12, 13 và 15, 16 Sheets"TONGHOP" chưa được anh ạ,
Em lọc thôn Khuổi Phầy: Mã 1 kết quả cho như bảng sau
[TABLE="class: grid, width: 370, align: center"]
[TR]
[TD="align: center"]Thua_dat[/TD]
[TD="align: center"]To_BD[/TD]
[TD="align: center"]To_BDcu[/TD]
[TD="align: center"]THUA_DATcu[/TD]
[/TR]
[TR]
[TD="align: center"]13[/TD]
[TD="align: center"]14[/TD]
[TD="align: center"]28[/TD]
[TD="align: center"]29[/TD]
[/TR]
[TR]
[TD="align: center"]10 thửa[/TD]
[TD="align: center"]9[/TD]
[TD="align: center"]3 tờ bản đồ[/TD]
[TD="align: center"]10 thửa[/TD]
[/TR]
[TR]
[TD="align: center"]11 thửa[/TD]
[TD="align: center"]5 tờ bản đồ[/TD]
[TD="align: center"]3 tờ bản đồ[/TD]
[TD="align: center"]12 thửa[/TD]
[/TR]
[TR]
[TD="align: center"]6 thửa[/TD]
[TD="align: center"]2 tờ bản đồ[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]7 thửa[/TD]
[/TR]
[TR]
[TD="align: center"]12 thửa[/TD]
[TD="align: center"]3 tờ bản đồ[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]13 thửa[/TD]
[/TR]
[TR]
[TD="align: center"]5 thửa[/TD]
[TD="align: center"]2 tờ bản đồ[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]5 thửa[/TD]
[/TR]
[TR]
[TD="align: center"]4 thửa[/TD]
[TD="align: center"]6[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]5 thửa[/TD]
[/TR]
[TR]
[TD="align: center"]5 thửa[/TD]
[TD="align: center"]5[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]5 thửa[/TD]
[/TR]
[TR]
[TD="align: center"]60[/TD]
[TD="align: center"]6[/TD]
[TD="align: center"] [/TD]
[TD="align: center"] [/TD]
[/TR]
[/TABLE]
Yêu cầu của chương trình là:
ở cả 4 cột là 12, 13 và 15, 16 nếu 1 chủ quản lý ở Cột 12, 16 mà đếm được 1 thửa thì ghi số thửa tìm được bên Sheets"DATA", và ghi tờ bản đồ tìm được bên Sheets"DATA" đối với thửa cũ thì ghi thông tin ở các cột [TABLE="class: cms_table_cms_table, width: 464"]
[TR]
[TD="class: cms_table_cms_table_xl67, width: 86"]SO_GCNcu[/TD]
[TD="class: cms_table_cms_table_xl68, width: 107"]NGAY_CAPcu[/TD]
[TD="class: cms_table_cms_table_xl67, width: 71"]MDSDcu[/TD]
[/TR]
[/TABLE]
Nếu 1 chủ quản lý ở cột 12, 16 đếm được số thửa > 1 thì ghi là Số thửa đếm được + chữ "thửa", ghi số tờ bản đồ đếm được + chữ "tờ bản đồ" (VD một chủ quản lý co 5 thửa và cũng chỉ có 1 tờ bản đồ (là tờ số 5) thì ghi là 5 thửa ở cột 12, 1 tờ bản đồ ở cột 13 và ở cột 16 có 7 thửa và cũng chỉ có 1 tờ bản đồ (là tờ số 1) thì ghi là 7 thửa ở cột 16, 1 tờ bản đồ ở cột 15
Khi chạy chương trình lọc của anh viết thì ở phần em bôi màu xanh là chưa đúng ạ
Mong anh kiểm tra lại giúp em
em cảm ơn anh đã nhiệt tình giúp đỡ

sealand · 27/8/14

Để dáp ứng yêu cầu của bạn tôi xin điều chỉnh toàn bộ Code như sau:

Mã:

Sub GPExyz()
Dim Dic As Object, sArr(), dArr(), Col(), i As Long, j As Long, k As Long, GPE, Id
Dim DKThon As String, DKMa As Long
Set Dic = CreateObject("Scripting.Dictionary")
DKThon = UCase(Sheets("TONGHOP").[B2])
DKMa = Sheets("TONGHOP").[E2].Value
    sArr = Sheets("Data").Range(Sheets("Data").[A3], Sheets("Data").[A3].End(xlDown)).Resize(, 44).Value
For i = 1 To UBound(sArr, 1)
    'Kiem tra neu dung Thon va CMND thi thuc hien 2 viec sau
    If UCase(sArr(i, 3)) = DKThon And sArr(i, 44) = DKMa Then
            'Neu trong Danh sach chua co thi Bo xung vao Danh sach
            If Not Dic.Exists(sArr(i, 5)) Then
            k = k + 1
            Dic.Add sArr(i, 5), k
            ReDim Preserve dArr(1 To 22, 1 To k)
            For j = 1 To 11
            dArr(j, k) = sArr(i, j + 1)
            Next
            dArr(21, k) = sArr(i, 26)
            dArr(22, k) = sArr(i, 27)
            End If
            'Tong hop du lieu vao Danh sach
            Id = Dic.Item(sArr(i, 5))
            dArr(12, Id) = JoinStr(dArr(12, Id), sArr(i, 13))
            dArr(13, Id) = JoinStr(dArr(13, Id), sArr(i, 14))
            dArr(14, Id) = dArr(14, Id) + sArr(i, 15)
            dArr(15, Id) = JoinStr(dArr(15, Id), sArr(i, 28))
            dArr(16, Id) = JoinStr(dArr(16, Id), sArr(i, 29))
            dArr(17, Id) = dArr(17, Id) + sArr(i, 30)
            If sArr(i, 31) <> "" Then dArr(18, Id) = JoinStr(dArr(18, Id), sArr(i, 31))
            If sArr(i, 32) <> "" Then dArr(19, Id) = JoinStr(dArr(19, Id), sArr(i, 32))
            If sArr(i, 33) <> "" Then dArr(20, Id) = JoinStr(dArr(20, Id), sArr(i, 33))
    End If
  Next
          For i = 1 To k
                dArr(12, i) = SetVl(dArr(12, i), True)
                dArr(13, i) = SetVl(dArr(13, i), False)
                dArr(15, i) = SetVl(dArr(15, i), False)
                dArr(16, i) = SetVl(dArr(16, i), True)
                dArr(18, i) = Replace(dArr(18, Id), "%", "  ")
                dArr(19, i) = Replace(dArr(19, Id), "%", "  ")
                dArr(20, i) = Replace(dArr(20, Id), "%", "  ")
         Next
With Sheets("TONGHOP")
    .[A5:A1000].Resize(, 22).ClearContents
    If k Then .[A5].Resize(k, 22).Value = WorksheetFunction.Transpose(dArr)
End With
End Sub
'==========================================================
Function JoinStr(ByVal Ch1 As String, ByVal Ch2 As String) As String
Dim Sp(), ch As String, i
Ch1 = Trim(Ch1): Ch2 = Trim(Ch2)
If InStr(1, Ch1, "%" & Ch2 & "%") > 0 Then
JoinStr = Ch1
Exit Function
Else
Sp = Array("#", "@", "&", "\", ";", "+", "-", "_", "|")
ch = "%" & Ch1 & "%" & Ch2 & "%"
For i = 0 To UBound(Sp)
ch = Replace(ch, Sp(i), "%")
Next
Do While InStr(1, ch, "%%") > 0
ch = Replace(ch, "%%", "%")
Loop
JoinStr = ch
End If
End Function
'==============================================================
Function SetVl(ByVal ch As String, Thua As Boolean) As String
Dim mStr, mCh, tm, i, j
If ch = "%" Then
Exit Function
Else
If Thua Then
mStr = " th" & ChrW(7917) & "a"
Else
mStr = " t" & ChrW(7901) & " b" & ChrW(7843) & "n " & ChrW(273) & ChrW(7891)
End If
mCh = Mid(ch, 2, Len(ch) - 2)
tm = Split(mCh, "%")
If UBound(tm) = 0 Then
SetVl = tm(0)
Else
SetVl = UBound(tm) + 1 & mStr
End If
End If
End Function

baquang1984 · 27/8/14

sealand đã viết:
Để dáp ứng yêu cầu của bạn tôi xin điều chỉnh toàn bộ Code như sau:

Em cảm ơn anh sealand!
Code de của anh sealand khi lọc kết quả sang Sheets"TONGHOP" đều cho kết quả như thế này ạ
Ví dụ lọc thôn [TABLE="width: 487"]
[TR]
[TD]Thôn:[/TD]
[TD]Thôn Khuổi Phầy[/TD]
[TD][/TD]
[TD]Mã:[/TD]
[TD]1[/TD]
[/TR]
[/TABLE]
Kết quả cho ra
[TABLE="class: grid, width: 915, align: center"]
[TR]
[TD="align: center"]Thua_dat[/TD]
[TD="align: center"]To_BD[/TD]
[TD="align: center"]Dien_Tich[/TD]
[TD="align: center"]To_BDcu[/TD]
[TD="align: center"]THUA_DATcu[/TD]
[TD="align: center"]DIEN_TICHcu[/TD]
[TD="align: center"]SO_GCNcu[/TD]
[TD="align: center"]NGAY_CAPcu[/TD]
[TD="align: center"]MDSDcu[/TD]
[/TR]
[TR]
[TD="align: center"]13[/TD]
[TD="align: center"]14[/TD]
[TD="align: center"]15[/TD]
[TD="align: center"]28[/TD]
[TD="align: center"]29[/TD]
[TD="align: center"]30[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]10 thửa[/TD]
[TD="align: center"]4 tờ bản đồ[/TD]
[TD="align: center"]3.985,0[/TD]
[TD="align: center"]3 tờ bản đồ[/TD]
[TD="align: center"]10 thửa[/TD]
[TD="align: center"]3.687,00[/TD]
[TD="align: center"]50[/TD]
[TD="align: center"][/TD]
[TD="align: center"] LUC[/TD]
[/TR]
[TR]
[TD="align: center"]11 thửa[/TD]
[TD="align: center"]5 tờ bản đồ[/TD]
[TD="align: center"]4.234,8[/TD]
[TD="align: center"]3 tờ bản đồ[/TD]
[TD="align: center"]12 thửa[/TD]
[TD="align: center"]4.000,00[/TD]
[TD="align: center"]50[/TD]
[TD="align: center"][/TD]
[TD="align: center"] LUC[/TD]
[/TR]
[TR]
[TD="align: center"]6 thửa[/TD]
[TD="align: center"]2 tờ bản đồ[/TD]
[TD="align: center"]1.430,4[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]7 thửa[/TD]
[TD="align: center"]1.738,00[/TD]
[TD="align: center"]50[/TD]
[TD="align: center"][/TD]
[TD="align: center"] LUC[/TD]
[/TR]
[TR]
[TD="align: center"]12 thửa[/TD]
[TD="align: center"]3 tờ bản đồ[/TD]
[TD="align: center"]4.165,9[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]13 thửa[/TD]
[TD="align: center"]3.876,00[/TD]
[TD="align: center"]50[/TD]
[TD="align: center"][/TD]
[TD="align: center"] LUC[/TD]
[/TR]
[TR]
[TD="align: center"]5 thửa[/TD]
[TD="align: center"]2 tờ bản đồ[/TD]
[TD="align: center"]1.121,3[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]5 thửa[/TD]
[TD="align: center"]726,00[/TD]
[TD="align: center"]50[/TD]
[TD="align: center"][/TD]
[TD="align: center"] LUC[/TD]
[/TR]
[TR]
[TD="align: center"]4 thửa[/TD]
[TD="align: center"]6[/TD]
[TD="align: center"]1.188,6[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]4 thửa[/TD]
[TD="align: center"]1.172,00[/TD]
[TD="align: center"]50[/TD]
[TD="align: center"][/TD]
[TD="align: center"] LUC[/TD]
[/TR]
[TR]
[TD="align: center"]5 thửa[/TD]
[TD="align: center"]5[/TD]
[TD="align: center"]837,9[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]4 thửa[/TD]
[TD="align: center"]1.576,00[/TD]
[TD="align: center"]50[/TD]
[TD="align: center"][/TD]
[TD="align: center"] LUC[/TD]
[/TR]
[TR]
[TD="align: center"]60[/TD]
[TD="align: center"]6[/TD]
[TD="align: center"]872,2[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]682[/TD]
[TD="align: center"]798,00[/TD]
[TD="align: center"]50[/TD]
[TD="align: center"][/TD]
[TD="align: center"] LUC[/TD]
[/TR]
[TR]
[TD="align: center"]5 thửa[/TD]
[TD="align: center"]3 tờ bản đồ[/TD]
[TD="align: center"]1.605,5[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]5 thửa[/TD]
[TD="align: center"]1.168,00[/TD]
[TD="align: center"]50[/TD]
[TD="align: center"][/TD]
[TD="align: center"] LUC[/TD]
[/TR]
[TR]
[TD="align: center"]3 thửa[/TD]
[TD="align: center"]2 tờ bản đồ[/TD]
[TD="align: center"]1.038,1[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]3 thửa[/TD]
[TD="align: center"]1.004,00[/TD]
[TD="align: center"]50[/TD]
[TD="align: center"][/TD]
[TD="align: center"] LUC[/TD]
[/TR]
[TR]
[TD="align: center"]3 thửa[/TD]
[TD="align: center"]2 tờ bản đồ[/TD]
[TD="align: center"]723,9[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]3 thửa[/TD]
[TD="align: center"]674,00[/TD]
[TD="align: center"]50[/TD]
[TD="align: center"][/TD]
[TD="align: center"] LUC[/TD]
[/TR]
[/TABLE]
Kết quả ghi ở To_BDcu chưa đúng ạ vì cột THUA_DATcu ghi là 7 thửa
Đúng là ở cột To_BDcu ghi là 1 tờ bản đồ, cột THUA_DATcu ghi là 7 thưa
Còn các cột SO_GCNcu, NGAY_CAPcu, MDSDcu chi ghi khi cột THUA_DATcu = số 1
Mong được anh kiểm tra lại giúp em ạ

baquang1984 · 27/8/14

Đây làm bảng dữ liệu khi lọc sang Sheets"TONGHOP" mà em mong muốn
[TABLE="class: grid, width: 934, 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]
[TD="align: center"]To_BDcu[/TD]
[TD="align: center"]THUA_DATcu[/TD]
[TD="align: center"]SO_GCNcu[/TD]
[TD="align: center"]NGAY_CAPcu[/TD]
[TD="align: center"]MDSDcu[/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: center"]3[/TD]
[TD="align: center"]13[/TD]
[TD="align: center"]14[/TD]
[TD="align: center"]28[/TD]
[TD="align: center"]29[/TD]
[TD="align: center"]31[/TD]
[TD="align: center"]01/02/1900[/TD]
[TD="align: center"]33[/TD]
[/TR]
[TR]
[TD="align: center"]Lý Văn Đoàn[/TD]
[TD="align: center"]Thôn Khuổi Phầy[/TD]
[TD="align: center"]10 thửa[/TD]
[TD="align: center"]1 tờ bản đồ[/TD]
[TD="align: center"]3 tờ bản đồ[/TD]
[TD="align: center"]10 thửa[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]Lý Văn Hải[/TD]
[TD="align: center"]Thôn Khuổi Phầy[/TD]
[TD="align: center"]11 thửa[/TD]
[TD="align: center"]5 tờ bản đồ[/TD]
[TD="align: center"]3 tờ bản đồ[/TD]
[TD="align: center"]12 thửa[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/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"]6 thửa[/TD]
[TD="align: center"]2 tờ bản đồ[/TD]
[TD="align: center"]1 tờ bản đồ[/TD]
[TD="align: center"]7 thửa[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]Mã Văn Chí[/TD]
[TD="align: center"]Thôn Khuổi Phầy[/TD]
[TD="align: center"]12 thửa[/TD]
[TD="align: center"]3 tờ bản đồ[/TD]
[TD="align: center"]1 tờ bản đồ[/TD]
[TD="align: center"]13 thửa[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]Mã Văn Dáy[/TD]
[TD="align: center"]Thôn Khuổi Phầy[/TD]
[TD="align: center"]5 thửa[/TD]
[TD="align: center"]2 tờ bản đồ[/TD]
[TD="align: center"]1 tờ bản đồ[/TD]
[TD="align: center"]5 thửa[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]Mã Văn Nguyên[/TD]
[TD="align: center"]Thôn Khuổi Phầy[/TD]
[TD="align: center"]4 thửa[/TD]
[TD="align: center"]1 tờ bản đồ[/TD]
[TD="align: center"]1 tờ bản đồ[/TD]
[TD="align: center"]5 thửa[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/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"]5 thửa[/TD]
[TD="align: center"]1 tờ bản đồ[/TD]
[TD="align: center"]1 tờ bản đồ[/TD]
[TD="align: center"]5 thửa[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/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"]60[/TD]
[TD="align: center"]6[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]682[/TD]
[TD="align: center"]57[/TD]
[TD="align: center"][/TD]
[TD="align: center"]LUC[/TD]
[/TR]
[TR]
[TD="align: center"]Mã Văn Tựa[/TD]
[TD="align: center"]Thôn Khuổi Phầy[/TD]
[TD="align: center"]5 thửa[/TD]
[TD="align: center"]3 tờ bản đồ[/TD]
[TD="align: center"]1 tờ bản đồ[/TD]
[TD="align: center"]5 thửa[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]Vi Văn Đội[/TD]
[TD="align: center"]Thôn Khuổi Phầy[/TD]
[TD="align: center"]3 thửa[/TD]
[TD="align: center"]2 tờ bản đồ[/TD]
[TD="align: center"]1 tờ bản đồ[/TD]
[TD="align: center"]3 thửa[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]Vy Văn Bộ[/TD]
[TD="align: center"]Thôn Khuổi Phầy[/TD]
[TD="align: center"]3 thửa[/TD]
[TD="align: center"]2 tờ bản đồ[/TD]
[TD="align: center"]1 tờ bản đồ[/TD]
[TD="align: center"]3 thửa[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[/TABLE]

Mong được sự giúp đỡ từ các anh và các thành viên trên diễn đàn!

sealand · 27/8/14

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

Mã:

Sub GPExyz()
Dim Dic As Object, sArr(), dArr(), Col(), i As Long, j As Long, k As Long, GPE, Id
Dim DKThon As String, DKMa As Long
Set Dic = CreateObject("Scripting.Dictionary")
DKThon = UCase(Sheets("TONGHOP").[B2])
DKMa = Sheets("TONGHOP").[E2].Value
    sArr = Sheets("Data").Range(Sheets("Data").[A3], Sheets("Data").[A3].End(xlDown)).Resize(, 44).Value
For i = 1 To UBound(sArr, 1)
    'Kiem tra neu dung Thon va CMND thi thuc hien 2 viec sau
    If UCase(sArr(i, 3)) = DKThon And sArr(i, 44) = DKMa Then
            'Neu trong Danh sach chua co thi Bo xung vao Danh sach
            If Not Dic.Exists(sArr(i, 5)) Then
            k = k + 1
            Dic.Add sArr(i, 5), k
            ReDim Preserve dArr(1 To 22, 1 To k)
            For j = 1 To 11
            dArr(j, k) = sArr(i, j + 1)
            Next
            dArr(21, k) = sArr(i, 26)
            dArr(22, k) = sArr(i, 27)
            End If
            'Tong hop du lieu vao Danh sach
            Id = Dic.Item(sArr(i, 5))
            dArr(12, Id) = JoinStr(dArr(12, Id), sArr(i, 13))
            dArr(13, Id) = JoinStr(dArr(13, Id), sArr(i, 14))
            dArr(14, Id) = dArr(14, Id) + sArr(i, 15)
            dArr(15, Id) = JoinStr(dArr(15, Id), sArr(i, 28))
            dArr(16, Id) = JoinStr(dArr(16, Id), sArr(i, 29))
            dArr(17, Id) = dArr(17, Id) + sArr(i, 30)
            If sArr(i, 31) <> "" Then dArr(18, Id) = JoinStr(dArr(18, Id), sArr(i, 31))
            If sArr(i, 32) <> "" Then dArr(19, Id) = JoinStr(dArr(19, Id), sArr(i, 32))
            If sArr(i, 33) <> "" Then dArr(20, Id) = JoinStr(dArr(20, Id), sArr(i, 33))
    End If
  Next
          For i = 1 To k
                dArr(12, i) = SetVl(dArr(12, i), True)
                dArr(13, i) = SetVl(dArr(13, i), False)
                dArr(16, i) = SetVl(dArr(16, i), True)
                dArr(15, i) = SetVl(dArr(15, i), False, Right(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
'==========================================================
Function JoinStr(ByVal Ch1 As String, ByVal Ch2 As String) As String
Dim Sp(), ch As String, i
Ch1 = Trim(Ch1): Ch2 = Trim(Ch2)
If InStr(1, Ch1, "%" & Ch2 & "%") > 0 Then
JoinStr = Ch1
Exit Function
Else
Sp = Array("#", "@", "&", "\", ";", "+", "-", "_", "|")
ch = "%" & Ch1 & "%" & Ch2 & "%"
For i = 0 To UBound(Sp)
ch = Replace(ch, Sp(i), "%")
Next
Do While InStr(1, ch, "%%") > 0
ch = Replace(ch, "%%", "%")
Loop
JoinStr = ch
End If
End Function
'=====================================================================
Function SetVl(ByVal ch As String, Thua As Boolean, Optional Dk As Boolean = True) As String
Dim mStr, mCh, tm, i, j
If ch = "%" Then
Exit Function
Else
If Thua Then
mStr = " th" & ChrW(7917) & "a"
Else
mStr = " t" & ChrW(7901) & " b" & ChrW(7843) & "n " & ChrW(273) & ChrW(7891)
End If
mCh = Mid(ch, 2, Len(ch) - 2)
tm = Split(mCh, "%")
If UBound(tm) = 0 Then
If Thua Then
SetVl = tm(0)
Else
 SetVl = IIf(Dk, 1 & mStr, tm(0))
End If
Else
SetVl = UBound(tm) + 1 & mStr
End If
End If
End Function

baquang1984 · 27/8/14

sealand đã viết:
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 · 27/8/14

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 · 27/8/14

sealand đã viết:
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 · 27/8/14

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

Mã:

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 · 27/8/14

sealand đã viết:
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 · 27/8/14

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 · 27/8/14

sealand đã viết:
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 · 4/8/15

sealand đã viết:

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

Mã:

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!

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)

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

Thành viên tiêu biểu

File đính kèm

Thành viên hoạt động

0901452không62

File đính kèm

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

Cạo Rồi Khỏi Gội

Hướng tới tương lai

Thành viên tiêu biểu

Thành viên tiêu biểu

Thành viên tiêu biểu

Thành viên tiêu biểu

File đính kèm

Thành viên tiêu biểu

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

File đính kèm

Thành viên tiêu biểu

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

Thành viên tiêu biểu

Biên Hòa, Đồng Nai

Thành viên tiêu biểu

Đang đi tìm hòn đá

Thành viên tiêu biểu

Biên Hòa, Đồng Nai

Thành viên tiêu biểu

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

Thành viên tiêu biểu

Cạo Rồi Khỏi Gội

File đính kèm

Thành viên tiêu biểu

File đính kèm

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

Thành viên tiêu biểu

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

Cạo Rồi Khỏi Gội

Thành viên tiêu biểu

Thành viên tiêu biểu

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

Thành viên tiêu biểu

Cạo Rồi Khỏi Gội

File đính kèm

Thành viên tiêu biểu

Biên Hòa, Đồng Nai

Thành viên tiêu biểu

Thành viên tiêu biểu

Biên Hòa, Đồng Nai

Cạo Rồi Khỏi Gội

Thành viên tiêu biểu

Thành viên tiêu biểu

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

Thành viên tiêu biểu

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

File đính kèm

Thành viên tiêu biểu

File đính kèm

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

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

Thành viên tiêu biểu

Cạo Rồi Khỏi Gội

File đính kèm

Thành viên tiêu biểu

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

Thành viên tiêu biểu

Thành viên tiêu biểu

Cạo Rồi Khỏi Gội

File đính kèm

Thành viên tiêu biểu

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

Thành viên tiêu biểu

Thành viên tiêu biểu

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

File đính kèm

Thành viên tiêu biểu

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

Thành viên tiêu biểu

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

Thành viên tiêu biểu

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