Lọc dữ liệu có điều kiện và Merge Cell

Liên hệ QC
baquang1984

baquang1984

Thành viên tiêu biểu
Tham gia
3/6/10
Bài viết
429
Được thích
44
Nghề nghiệp
Kỹ sư Lâm nghiệp
Em chào Thầy cô và anh chị trên diễn đàn ạ
Em nhờ thầy cô và anh chị trên diễn đàn viết giúp em Code VBA để thực hiện chương trình như sau ạ:
Em có sheets"DATA" là sheet chứa dữ liệu cần lọc, khi em chọn điều kiện lọc ở cột I2 sheets"KETQUA" thì chương trình sẽ lọc dữ liệu sang sheets"KETQUA"
Dữ liệu được điền như sau:
Cột A sheets"KETQUA" dữ liệu lấy từ cột A Sheets"DATA" và Mergen các ô theo giá trị của điều kiện và điền một giá trị Như file đính kèm
Cột B sheets"KETQUA" dữ liệu được lấy từ cột D sheets"DATA và Mergen các ô theo giá trị của điều kiện và điền một giá trị
Cột C sheets"KETQUA" lấy dữ liệu được lấy từ cột E sheets"DATA"
Cột D sheets"KETQUA" lấy dữ liệu được lấy từ cột F sheets"DATA"
Cột E sheets"KETQUA" lấy dữ liệu được lấy từ cột G sheets"DATA"
Cột F sheets"KETQUA" lấy dữ liệu được lấy từ cột H sheets"DATA"
kết thúc mỗi điều kiện có dòng tính tổng ở cột C sheets"KETQUA" đếm xem có bao nhiêu thửa đất
ở cột D sheets"KETQUA" đếm xem có bao nhiêu tờ bản đồ, ở cột F tính tổng diện tích
Với trường hợp chọn vào Button "LỌC TẤT CẢ" chương trình sẽ lọc toàn bộ dữ liệu bên sheets"DATA" sang sheets"KETQUA" với điều kiện như trên
Dữ liệu và kết quả mong muốn em đã thể hiện trong file đính kèm ạ
Em cảm ơn Thầy cô và anh chị trên diễn đàn giúp đỡ ạ
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
baquang1984 đã viết:
Em chào Thầy cô và anh chị trên diễn đàn ạ
Em nhờ thầy cô và anh chị trên diễn đàn viết giúp em Code VBA để thực hiện chương trình như sau ạ:
Em có sheets"DATA" là sheet chứa dữ liệu cần lọc, khi em chọn điều kiện lọc ở cột I2 sheets"KETQUA" thì chương trình sẽ lọc dữ liệu sang sheets"KETQUA"
Dữ liệu được điền như sau:
Cột A sheets"KETQUA" dữ liệu lấy từ cột A Sheets"DATA" và Mergen các ô theo giá trị của điều kiện và điền một giá trị Như file đính kèm
Cột B sheets"KETQUA" dữ liệu được lấy từ cột D sheets"DATA và Mergen các ô theo giá trị của điều kiện và điền một giá trị
Cột C sheets"KETQUA" lấy dữ liệu được lấy từ cột E sheets"DATA"
Cột D sheets"KETQUA" lấy dữ liệu được lấy từ cột F sheets"DATA"
Cột E sheets"KETQUA" lấy dữ liệu được lấy từ cột G sheets"DATA"
Cột F sheets"KETQUA" lấy dữ liệu được lấy từ cột H sheets"DATA"
kết thúc mỗi điều kiện có dòng tính tổng ở cột C sheets"KETQUA" đếm xem có bao nhiêu thửa đất
ở cột D sheets"KETQUA" đếm xem có bao nhiêu tờ bản đồ, ở cột F tính tổng diện tích
Với trường hợp chọn vào Button "LỌC TẤT CẢ" chương trình sẽ lọc toàn bộ dữ liệu bên sheets"DATA" sang sheets"KETQUA" với điều kiện như trên
Dữ liệu và kết quả mong muốn em đã thể hiện trong file đính kèm ạ
Em cảm ơn Thầy cô và anh chị trên diễn đàn giúp đỡ ạ
Nhấp chuột vào đây để mở rộng...
Viet cho TH1
Mã: 
Sub filter()
    Dim i, j, ar, filter_text, kq, k
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    filter_text = Sheet2.Range("I2")
    With Sheet1
        ar = .Range("A2:H" & .Range("A" & Rows.Count).End(3).Row)
    End With
    ReDim kq(1 To UBound(ar), 1 To 6)
    For i = 1 To UBound(ar)
        If ar(i, 3) = filter_text Then
            k = k + 1
            kq(k, 1) = ar(i, 1)
            For j = 2 To 6
                kq(k, j) = ar(i, j + 2)
            Next
        End If
    Next
    With Sheet2
        .Range("A2:F" & .Range("F" & Rows.Count).End(3).Row + 1).Clear
        If k Then
            .Range("A2").Resize(k, 6) = kq
            mergedk
        End If
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
Sub mergedk()
    Dim lr, ar
    With Sheet2
        lr = .Range("A" & Rows.Count).End(3).Row
        ar = .Range("A1:F" & lr)
        For i = UBound(ar) To 1 Step -1
            For j = i To 1 Step -1
                If ar(j, 1) <> ar(i, 1) Or ar(j, 2) <> ar(i, 2) Then
                    .Range("A" & j + 1 & ":A" & i).merge
                    .Range("B" & j + 1 & ":B" & i).merge
                    .Rows(i + 1 & ":" & i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                    .Range("C" & i + 1) = i - j
                    i = j + 1
                    Exit For
                End If
            Next
        Next
    End With
End Sub
 
Upvote 0
quanluu1989 đã viết:
Viet cho TH1
Mã: 
Sub filter()
    Dim i, j, ar, filter_text, kq, k
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    filter_text = Sheet2.Range("I2")
    With Sheet1
        ar = .Range("A2:H" & .Range("A" & Rows.Count).End(3).Row)
    End With
    ReDim kq(1 To UBound(ar), 1 To 6)
    For i = 1 To UBound(ar)
        If ar(i, 3) = filter_text Then
            k = k + 1
            kq(k, 1) = ar(i, 1)
            For j = 2 To 6
                kq(k, j) = ar(i, j + 2)
            Next
        End If
    Next
    With Sheet2
        .Range("A2:F" & .Range("F" & Rows.Count).End(3).Row + 1).Clear
        If k Then
            .Range("A2").Resize(k, 6) = kq
            mergedk
        End If
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
Sub mergedk()
    Dim lr, ar
    With Sheet2
        lr = .Range("A" & Rows.Count).End(3).Row
        ar = .Range("A1:F" & lr)
        For i = UBound(ar) To 1 Step -1
            For j = i To 1 Step -1
                If ar(j, 1) <> ar(i, 1) Or ar(j, 2) <> ar(i, 2) Then
                    .Range("A" & j + 1 & ":A" & i).merge
                    .Range("B" & j + 1 & ":B" & i).merge
                    .Rows(i + 1 & ":" & i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                    .Range("C" & i + 1) = i - j
                    i = j + 1
                    Exit For
                End If
            Next
        Next
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn bác quanluu1989 đã giúp đỡ ạ. Anh xem lại code giúp em với ạ đối với trường hợp một là khi em chọn điều kiện lọc ở ô cell I2 thì chương trình thực hiện lọc theo như em mô tả ở bài #1 ạ. Còn trường hợp 2 là khi em chọn Buttom "LỌC TẤT CẢ" thì chương trình sẽ lọc toàn bộ dữ liệu có bên Sheets"DATA" sang Sheets"KETQUA". Em cảm ơn nhiều ạ
 
Upvote 0
baquang1984 đã viết:
Em chào Thầy cô và anh chị trên diễn đàn ạ
Em nhờ thầy cô và anh chị trên diễn đàn viết giúp em Code VBA để thực hiện chương trình như sau ạ:
Em có sheets"DATA" là sheet chứa dữ liệu cần lọc, khi em chọn điều kiện lọc ở cột I2 sheets"KETQUA" thì chương trình sẽ lọc dữ liệu sang sheets"KETQUA"
Dữ liệu được điền như sau:
Cột A sheets"KETQUA" dữ liệu lấy từ cột A Sheets"DATA" và Mergen các ô theo giá trị của điều kiện và điền một giá trị Như file đính kèm
Cột B sheets"KETQUA" dữ liệu được lấy từ cột D sheets"DATA và Mergen các ô theo giá trị của điều kiện và điền một giá trị
Cột C sheets"KETQUA" lấy dữ liệu được lấy từ cột E sheets"DATA"
Cột D sheets"KETQUA" lấy dữ liệu được lấy từ cột F sheets"DATA"
Cột E sheets"KETQUA" lấy dữ liệu được lấy từ cột G sheets"DATA"
Cột F sheets"KETQUA" lấy dữ liệu được lấy từ cột H sheets"DATA"
kết thúc mỗi điều kiện có dòng tính tổng ở cột C sheets"KETQUA" đếm xem có bao nhiêu thửa đất
ở cột D sheets"KETQUA" đếm xem có bao nhiêu tờ bản đồ, ở cột F tính tổng diện tích
Với trường hợp chọn vào Button "LỌC TẤT CẢ" chương trình sẽ lọc toàn bộ dữ liệu bên sheets"DATA" sang sheets"KETQUA" với điều kiện như trên
Dữ liệu và kết quả mong muốn em đã thể hiện trong file đính kèm ạ
Em cảm ơn Thầy cô và anh chị trên diễn đàn giúp đỡ ạ
Nhấp chuột vào đây để mở rộng...
- Tôi không thấy tác dụng của Merge Cells để làm gì nên không làm.
- Chọn trong List số CMND ô I2 thì lọc đúng số CMND đó, Nếu Delete ô I2 thì lấy tất cả dữ liệu có bên Data.
 

File đính kèm

Upvote 0
Ba Tê đã viết:
- Tôi không thấy tác dụng của Merge Cells để làm gì nên không làm.
- Chọn trong List số CMND ô I2 thì lọc đúng số CMND đó, Nếu Delete ô I2 thì lấy tất cả dữ liệu có bên Data.
Nhấp chuột vào đây để mở rộng...
Cảm ơn bác Ba Tê chương trình chạy tuyệt vời. Bác có thể giúp em thêm phần Merge Cell được không ạ. Mục đích của em hỏi phần này là để ứng dụng thêm vào các chương trình khác ạ
 
Upvote 0
Thân chào các Anh/Chị/Em trên diễn đàn
Tôi muốn nhờ các ace giúp tôi tổng hợp Dữ liệu của 1 file Có nhiều Sheet, Mỗi Sheet có cấu trúc giống hệt nhau của các năm có chia theo danh sách các tỉnh. Tôi muốn tạo sheet tổng hợp dữ liệu của các tỉnh theo năm.
VD: Cả nước thì sẽ lấy dữ liệu từ năm 2010 - 2015, xong lại tiếp tục đến các tỉnh khác theo đúng thứ tự các tỉnh theo cột.
Rất mong được sự giúp đỡ của các ace.
 

File đính kèm

Upvote 0
baquang1984 đã viết:
Bác có thể giúp em thêm phần Merge Cell được không ạ. Mục đích của em hỏi phần này là để ứng dụng thêm vào các chương trình khác ạ
Nhấp chuột vào đây để mở rộng...
Dữ liệu Excel là phải chuẩn của Excel, Merge chỉ là làm bảng biểu để xem thôi, chứ sau này muốn Tìm, Lọc... từ bảng này sẽ "oải".
Sub MergeCells của bạn đây (áp dụng cho file này, sau khi chạy các Sub trước)
Chú ý là phải UnMerge cột A, B trước khi chạy các Sub trước.
PHP: 
Public Sub s_Merge()
Dim Rws As Long, I As Long, K As Long
Rws = Range("B100000").End(xlUp).Row
For I = 3 To Rws
    If Cells(I, 2) <> "TOTAL:" Then
        K = K + 1
    Else
        Cells(I, 1).Offset(-K).Resize(K + 1).Merge
        Cells(I, 2).Offset(-K).Resize(K).Merge
        Cells(I, 1).Offset(-K).Resize(K + 1, 2).VerticalAlignment = xlCenter
        K = 0
    End If
Next I
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Ba Tê đã viết:
- Tôi không thấy tác dụng của Merge Cells để làm gì nên không làm.
- Chọn trong List số CMND ô I2 thì lọc đúng số CMND đó, Nếu Delete ô I2 thì lấy tất cả dữ liệu có bên Data.
Nhấp chuột vào đây để mở rộng...
Bác Ba Tê ạ đối với trường hợp khi chon điều kiện lọc ở ô Cell I2 của số CMND "120923909" thì chương trình báo lỗi như ảnh gửi kèm anh, bác xem giúp em với nhé. Em cảm ơn anh nhiều ạ!
 

File đính kèm

  • Bao_Loi.jpg
    Bao_Loi.jpg
    71.5 KB · Đọc: 12
Upvote 0
baquang1984 đã viết:
Bác Ba Tê ạ đối với trường hợp khi chon điều kiện lọc ở ô Cell I2 của số CMND "120923909" thì chương trình báo lỗi như ảnh gửi kèm anh, bác xem giúp em với nhé. Em cảm ơn anh nhiều ạ!
Nhấp chuột vào đây để mở rộng...
Thay cái dòng lỗi màu vàng đó bằng dòng này:
PHP: 
sArr = .Range("A3", .Range("A100000").End(xlUp).Offset(1)).Resize(, 7).Value
 

File đính kèm

Upvote 0
tam888 đã viết:
Cách giúp đó có hẳn tốt cho bạn?
Bỏ cái merged đau khổ đi, bạn tham gia kỳ cựu bao nhiêu bài rồi mà vẫn bố trí dữ liệu vậy sao?
Nhấp chuột vào đây để mở rộng...
Cảm ơn góp ý của bác tuy nhiên do điều kiện em thực hiện các dự án nên yêu cầu của mỗi cơ quan quản lý nhà nước nó khác nhau em cũng a cay với cai kểu bố trí dữ liệu Merge này lắm
 
Upvote 0
tam888 đã viết:
Cách giúp đó có hẳn tốt cho bạn?
Bỏ cái merged đau khổ đi, bạn tham gia kỳ cựu bao nhiêu bài rồi mà vẫn bố trí dữ liệu vậy sao?
Nhấp chuột vào đây để mở rộng...
1/ Tôi nghĩ muốn tính cái gì đó thì đã có sheet DATA rồi.
2/ Sheet KETQUA chẳng qua làm trang trí theo quy định của cơ quan chứ chẳng ai muốn làm ba cái vụ Merge Merge này đâu, nếu không nhờ VBA trợ giúp thì một xã có từ 10.000 dòng trở lên là điếc.
3/ Tôi cũng đã làm xong rồi, chỉ còn gọt giũa code cho gọn lại một chút.

A_Ketqua.GIF
 
Lần chỉnh sửa cuối:
Upvote 0
VBA mà làm việc với merged cells là làm việc trên bãi mìn. Thể nào cũng có ngày mấy chân mất tay nếu không mất mạng.
Muón nói chuyện code và "tự động" thì phải bắt đầu tập quên cái vụ mẫu mã làm duyên làm dáng đi.

Nói với cái tên quản lý là chuyên viên trên 20 năm về dữ liệu, bảng tính, và kiểm soát dữ liệu quản lý (audit) nói vậy.
 
Upvote 0
Upvote 0
baquang1984 đã viết:
Cảm ơn góp ý của bác tuy nhiên do điều kiện em thực hiện các dự án nên yêu cầu của mỗi cơ quan quản lý nhà nước nó khác nhau em cũng a cay với cai kểu bố trí dữ liệu Merge này lắm
Nhấp chuột vào đây để mở rộng...
Thay đổi từ chính mình, thay vì tiếp tay tiếp cho việc cay đó phát triển

VetMini đã viết:
VBA mà làm việc với merged cells là làm việc trên bãi mìn. Thể nào cũng có ngày mấy chân mất tay nếu không mất mạng.
Muón nói chuyện code và "tự động" thì phải bắt đầu tập quên cái vụ mẫu mã làm duyên làm dáng đi.

Nói với cái tên quản lý là chuyên viên trên 20 năm về dữ liệu, bảng tính, và kiểm soát dữ liệu quản lý (audit) nói vậy.
Nhấp chuột vào đây để mở rộng...
Đúng thế, nhưng oái ăm thay là nhiều thành viên GPE khoái gỡ mìn...
Làm bước cuối cùng (đặt mìn) giao cho VBA thì được (tức là report có merged thì được)
 
Upvote 0
tam888 đã viết:
Thay đổi từ chính mình, thay vì tiếp tay tiếp cho việc cay đó phát triển


Đúng thế, nhưng oái ăm thay là nhiều thành viên GPE khoái gỡ mìn...
Làm bước cuối cùng (đặt mìn) giao cho VBA thì được (tức là report có merged thì được)
Nhấp chuột vào đây để mở rộng...
Chắc bạn không là công chức nên không biết, tất cả mọi công việc liên quan đến bảng tính đều phải làm theo biểu mẫu quy định.

Vì vậy, cách tốt nhất là thiết kế dữ liệu theo kiểu của mình sao cho thuận lợi nhất, khi cần báo cáo theo biểu mẫu quy định thì chạy code (cách làm của Chủ Topic nằm trong dạng này).
 
Upvote 0
be09 đã viết:
Chắc bạn không là công chức nên không biết, tất cả mọi công việc liên quan đến bảng tính đều phải làm theo biểu mẫu quy định.

Vì vậy, cách tốt nhất là thiết kế dữ liệu theo kiểu của mình sao cho thuận lợi nhất, khi cần báo cáo theo biểu mẫu quy định thì chạy code (cách làm của Chủ Topic nằm trong dạng này).
Nhấp chuột vào đây để mở rộng...
Công chức càng nên đổi, không hệ thống giờ quan liêu trì trệ quá
Còn tôi có nói trên
tam888 đã viết:
Thay đổi từ chính mình, thay vì tiếp tay tiếp cho việc cay đó phát triển

.....
Làm bước cuối cùng (đặt mìn) giao cho VBA thì được (tức là report có merged thì được)
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

ptm0412
  • Question Question
Lấy dữ liệu web nhiều trang về file Excel bằng Power Query
    • Thích
Trả lời
3
Đọc
2K
quick87
quick87
H
Công thức tìm kết quả
Trả lời
11
Đọc
98
VetMini
V
V
Hàm dò tìm lấy giá trị của lần xuất hiện thứ n trong excel.
Trả lời
9
Đọc
1K
VetMini
V
Huyen9
Lỗi không mailings được.
Trả lời
2
Đọc
42
Huyen9
Huyen9
Mewwo98
Thay dấu ngăn cách sau chữ số hàng nghìn, hàng triệu, hàng tỷ trong Mail Merge
Trả lời
1
Đọc
37
Hoàng Tuấn 868
H
N
Nhờ các anh chỉ chỉnh lỗi giúp em với ạ, em cảm ơn ạ.
Trả lời
3
Đọc
66
minhminh27
minhminh27
T
File quản lý thiết bị trong trường học!
Trả lời
4
Đọc
120
VetMini
V
Xoainon3005
Xin file mẫu kế hoạch sản xuất theo tháng ngành động cơ
Trả lời
1
Đọc
117
VetMini
V
Momominh
Sơ đồ hàng hóa trong Container
Trả lời
3
Đọc
112
VetMini
V
L
Viết phần mềm đánh lô bằng Visual Basic
    • Thích
2 3
Trả lời
51
Đọc
103K
taimeanh
T
hungtin1997
  • Question Question
[Hỏi] Tạo Hyperlink đến ô chạy ngang theo cột
Trả lời
6
Đọc
405
A HOANG 620
A
LuuAnh980
Add in tạo QR code miễn phí.
Trả lời
14
Đọc
541
htin1997
htin1997
tramcannt
Các bác cho hỏi làm cách nào để thu nhỏ thanh công thức này với ạ. Em cảm ơn.
Trả lời
2
Đọc
55
Nhattanktnn
Nhattanktnn
S
  • Question Question
Điều chỉnh kích thước dòng tự động theo trang in
Trả lời
5
Đọc
137
HUONGHCKT
H
A
Tạo vé Loto bằng Excel
2
Trả lời
20
Đọc
23K
Tuấn tata
Tuấn tata
Nauduong
Cách chuyển định dạng từ PDF sang Image
Trả lời
9
Đọc
258
Châu Bá Thông
Châu Bá Thông
minhduongct
  • Question Question
Viết code VBA thay cho dùng hàm vlookup
Trả lời
6
Đọc
1K
VetMini
V
N
Thử viết code lập trình đa luồng bằng TwinBasic và khả năng ứng dụng vào COM add-in chạy trong Excel
    • Thích
Trả lời
0
Đọc
166
nguyendang95
N
Thanh271188
Tìm giá trị xuất hiện bất kì (không phải giá trị đầu, cuối) trong excel
    • Cười
Trả lời
4
Đọc
223
Duy Tùng 9x
Duy Tùng 9x
H
Xin viết dùng mã vba thay thế cho hàm vlookup
    • Thích
12 13 14
Trả lời
264
Đọc
79K
VetMini
V
Xem thêm…

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

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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
Chúc mừng năm mới Ất Tỵ 2025
Back
Top Bottom