Lọc dữ liệu theo các giá trị lựa chọn từ list Validation (1 người xem)

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
DAOHUYENNEU

DAOHUYENNEU

Thành viên chính thức
Tham gia
9/2/10
Bài viết
51
Được thích
2
Em chào các bác ạ,
Em nhờ các bác giúp em giải quyết vấn đề trong file em đính kèm với nhé.
Em cảm ơn nhiều.
Chúc cả nhà một ngày tốt lành
 

File đính kèm

hungpecc1 đã viết:
Bạn ngâm cứu về cách sử dụng DaTa Validation, Advanced Filter --> thiết lập vùng tiêu chuẩn để lọc nhé!
Nhấp chuột vào đây để mở rộng...
Để em tìm hiểu xem sao. Dù sao em cũng muốn có bác nào đó giúp em thực hành luôn trên file em gửi kèm với ạ. Vì em cũng đang lơ mơ về cái này lam
 
DAOHUYENNEU đã viết:
Để em tìm hiểu xem sao. Dù sao em cũng muốn có bác nào đó giúp em thực hành luôn trên file em gửi kèm với ạ. Vì em cũng đang lơ mơ về cái này lam
Nhấp chuột vào đây để mở rộng...

Dữ liệu ngày tháng của bạn là kiểu gì vậy bạn? hình như không đồng nhất định dạng?
 
DAOHUYENNEU đã viết:
Em sửa lại định dạng ngày rồi ạ. Em gửi lại file anh xem giúp em nhé. Em cảm ơn anh
Nhấp chuột vào đây để mở rộng...
Trước mắt làm cho bạn trước 1 cái lọc dữ liệu của bảng data qua coi đúng ý chưa mình mới làm tiếp

[GPECODE=sql]Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
Dim adoConn As Object, adoRS As Object
Set adoConn = CreateObject("ADODB.Connection")
Set adoRS = CreateObject("ADODB.Recordset")
With adoConn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
.Open
End With
With adoRS
.ActiveConnection = adoConn
.Open "select * from [DATA$A2:F10000] " _
& "where F2 like '" & Sheet1.Range("B2").Value & "' and " _
& "F1 between #" & Format(DateSerial(Year(Sheet1.[b3]), Month(Sheet1.[b3]), Day(Sheet1.[b3])), "mm/dd/yyyy") _
& "# AND #" & Format(DateSerial(Year(Sheet1.[d3]), Month(Sheet1.[d3]), Day(Sheet1.[d3])), "mm/dd/yyyy") & "# "
End With
With Sheet1
.[A6:F10000].ClearContents
.[A6].CopyFromRecordset adoRS
End With
adoRS.Close: Set adoRS = Nothing
adoConn.Close: Set adoConn = Nothing

End If

End Sub


[/GPECODE]
 

File đính kèm

Hai Lúa Miền Tây đã viết:
Trước mắt làm cho bạn trước 1 cái lọc dữ liệu của bảng data qua coi đúng ý chưa mình mới làm tiếp

[GPECODE=sql]Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
Dim adoConn As Object, adoRS As Object
Set adoConn = CreateObject("ADODB.Connection")
Set adoRS = CreateObject("ADODB.Recordset")
With adoConn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
.Open
End With
With adoRS
.ActiveConnection = adoConn
.Open "select * from [DATA$A2:F10000] " _
& "where F2 like '" & Sheet1.Range("B2").Value & "' and " _
& "F1 between #" & Format(DateSerial(Year(Sheet1.[b3]), Month(Sheet1.[b3]), Day(Sheet1.[b3])), "mm/dd/yyyy") _
& "# AND #" & Format(DateSerial(Year(Sheet1.[d3]), Month(Sheet1.[d3]), Day(Sheet1.[d3])), "mm/dd/yyyy") & "# "
End With
With Sheet1
.[A6:F10000].ClearContents
.[A6].CopyFromRecordset adoRS
End With
adoRS.Close: Set adoRS = Nothing
adoConn.Close: Set adoConn = Nothing

End If

End Sub


[/GPECODE]
Nhấp chuột vào đây để mở rộng...

Có phải là anh mới chỉ xử lý cái chọn danh sách mã phải không ạ? Em thấy thế là đúng ý em rồi anh ạ. Giờ anh xử lý giúp em cái phần chọn ngày nữa nhé. Em cảm ơn ạ
 
DAOHUYENNEU đã viết:
Có phải là anh mới chỉ xử lý cái chọn danh sách mã phải không ạ? Em thấy thế là đúng ý em rồi anh ạ. Giờ anh xử lý giúp em cái phần chọn ngày nữa nhé. Em cảm ơn ạ
Nhấp chuột vào đây để mở rộng...
Hoàn chỉnh theo yêu cầu của bạn, mình có điều chỉnh dòng điều kiện lọc ngày lên trên cho hợp lý hơn.

[GPECODE=sql]Sub LocData()

Dim adoConn As Object, adoRS As Object
Set adoConn = CreateObject("ADODB.Connection")
Set adoRS = CreateObject("ADODB.Recordset")
With adoConn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
.Open
End With
With adoRS
.ActiveConnection = adoConn
.Open "select * from [DATA$A2:F10000] " _
& "where F2 like '" & Sheet1.Range("B3").Value & "' and " _
& "F1 between #" & Format(DateSerial(Year(Sheet1.[B2]), Month(Sheet1.[B2]), Day(Sheet1.[B2])), "mm/dd/yyyy") _
& "# AND #" & Format(DateSerial(Year(Sheet1.[d2]), Month(Sheet1.[d2]), Day(Sheet1.[d2])), "mm/dd/yyyy") & "# "
End With
With Sheet1
.[A6:F10000].ClearContents
.[A6].CopyFromRecordset adoRS
End With
adoRS.Close: Set adoRS = Nothing
adoConn.Close: Set adoConn = Nothing

End Sub
Sub LocTop50()
LocDuyNhat
Dim adoConn As Object, adoRS As Object
Set adoConn = CreateObject("ADODB.Connection")
Set adoRS = CreateObject("ADODB.Recordset")
With adoConn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
.Open
End With
With adoRS
.ActiveConnection = adoConn
.Open "select * from [DATA$A2:F10000] " _
& "where F2 like '" & Sheet1.Range("i3").Value & "' and " _
& "F1 between #" & Format(DateSerial(Year(Sheet1.[i2]), Month(Sheet1.[i2]), Day(Sheet1.[i2])), "mm/dd/yyyy") _
& "# AND #" & Format(DateSerial(Year(Sheet1.[k2]), Month(Sheet1.[k2]), Day(Sheet1.[k2])), "mm/dd/yyyy") & "# "
End With
With Sheet1
.[H6:M10000].ClearContents
.[H6].CopyFromRecordset adoRS
End With
adoRS.Close: Set adoRS = Nothing
adoConn.Close: Set adoConn = Nothing

End Sub

Sub LocDuyNhat()
Dim adoConn As Object, adoRS As Object
Set adoConn = CreateObject("ADODB.Connection")
Set adoRS = CreateObject("ADODB.Recordset")
With adoConn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
.Open
End With
With adoRS
.ActiveConnection = adoConn
.Open "select distinct f2 " _
& "from [DATA$A2:F10000] " _
& "where F2 is not null "
End With
With Sheet2
.[B2:B10000].ClearContents
.[B2].CopyFromRecordset adoRS
.Range("B2:B" & .[B65500].End(xlUp).Row).Name = "MaCK"
End With
adoRS.Close
With adoRS
.ActiveConnection = adoConn
.Open "select distinct f1 " _
& "from [DATA$A2:F10000] " _
& "where F1 is not null" ' and f2 like '" & Sheet1.Range("B2").Value & "'"
End With
With Sheet2
.[C2:C10000].ClearContents
.[C2].CopyFromRecordset adoRS
.Range("C2:C" & .[C65500].End(xlUp).Row).Name = "Ngay"
End With
adoRS.Close: Set adoRS = Nothing
adoConn.Close: Set adoConn = Nothing

End Sub


[/GPECODE]
 

File đính kèm

Lần chỉnh sửa cuối:
Hai Lúa Miền Tây đã viết:
Hoàn chỉnh theo yêu cầu của bạn, mình có điều chỉnh dòng điều kiện lọc ngày lên trên cho hợp lý hơn.
Nhấp chuột vào đây để mở rộng...
Anh Hai Lúa ơi, nếu em ko muốn tự lọc ra danh sách các mã và danh sách ngày (cái này anh đã lọc và cho vào sheet Top50 ấy) mà muốn dữ liệu lọc sẽ tự động lọc ra từ danh sách mã ck và ngày trong sheet Data luôn thì có đc không ạ. Phiền anh giúp nốt em với ạ
 
DAOHUYENNEU đã viết:
Anh Hai Lúa ơi, nếu em ko muốn tự lọc ra danh sách các mã và danh sách ngày (cái này anh đã lọc và cho vào sheet Top50 ấy) mà muốn dữ liệu lọc sẽ tự động lọc ra từ danh sách mã ck và ngày trong sheet Data luôn thì có đc không ạ. Phiền anh giúp nốt em với ạ
Nhấp chuột vào đây để mở rộng...

Chỉnh lại chút xíu là được. Bạn xoá cái sub LocDuyNhat cũ đi rồi chép cái sau vào:
[GPECODE=sql]Sub LocDuyNhat()
Dim adoConn As Object, adoRS As Object
Set adoConn = CreateObject("ADODB.Connection")
Set adoRS = CreateObject("ADODB.Recordset")
With adoConn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
.Open
End With
With adoRS
.ActiveConnection = adoConn
.Open "select distinct f2 " _
& "from [DATA$A2:F10000] " _
& "where F2 is not null "
End With
With Sheet3
.[H2:H10000].ClearContents
.[H2].CopyFromRecordset adoRS
.Range("H2:H" & .[H65500].End(xlUp).Row).Name = "MaCK"
End With
adoRS.Close
With adoRS
.ActiveConnection = adoConn
.Open "select distinct f1 " _
& "from [DATA$A2:F10000] " _
& "where F1 is not null" ' and f2 like '" & Sheet1.Range("B2").Value & "'"
End With
With Sheet3
.[I2:I10000].ClearContents
.[I2].CopyFromRecordset adoRS
.Range("I2:I" & .[I65500].End(xlUp).Row).Name = "Ngay"
End With
adoRS.Close: Set adoRS = Nothing
adoConn.Close: Set adoConn = Nothing

End Sub

[/GPECODE]
 
Hai Lúa Miền Tây đã viết:
Chỉnh lại chút xíu là được. Bạn xoá cái sub LocDuyNhat cũ đi rồi chép cái sau vào:
[GPECODE=sql]Sub LocDuyNhat()
Dim adoConn As Object, adoRS As Object
Set adoConn = CreateObject("ADODB.Connection")
Set adoRS = CreateObject("ADODB.Recordset")
With adoConn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
.Open
End With
With adoRS
.ActiveConnection = adoConn
.Open "select distinct f2 " _
& "from [DATA$A2:F10000] " _
& "where F2 is not null "
End With
With Sheet3
.[H2:H10000].ClearContents
.[H2].CopyFromRecordset adoRS
.Range("H2:H" & .[H65500].End(xlUp).Row).Name = "MaCK"
End With
adoRS.Close
With adoRS
.ActiveConnection = adoConn
.Open "select distinct f1 " _
& "from [DATA$A2:F10000] " _
& "where F1 is not null" ' and f2 like '" & Sheet1.Range("B2").Value & "'"
End With
With Sheet3
.[I2:I10000].ClearContents
.[I2].CopyFromRecordset adoRS
.Range("I2:I" & .[I65500].End(xlUp).Row).Name = "Ngay"
End With
adoRS.Close: Set adoRS = Nothing
adoConn.Close: Set adoConn = Nothing

End Sub

[/GPECODE]
Nhấp chuột vào đây để mở rộng...

Ok rồi anh ạ
anh cho em hỏi chút nữa nhé, trong đoạn code này & "where F2 like '" & Sheet1.Range("B3").Value & "' and " _ & "F1 between #" thì F1 và F2 có giá trị như thế nào ạ?
Em không rành lam nên nếu câu hỏi có buồn cười quá thì anh bỏ qua cho em nhé
 
DAOHUYENNEU đã viết:
Ok rồi anh ạ
anh cho em hỏi chút nữa nhé, trong đoạn code này & "where F2 like '" & Sheet1.Range("B3").Value & "' and " _ & "F1 between #" thì F1 và F2 có giá trị như thế nào ạ?
Em không rành lam nên nếu câu hỏi có buồn cười quá thì anh bỏ qua cho em nhé
Nhấp chuột vào đây để mở rộng...

F1 là cột thứ 1 trong sheet Data, tương tự F2 là cột 2...

where F2 like '" & Sheet1.Range("B3").Value
Nhấp chuột vào đây để mở rộng...

<---- Điều kiện là Cột Mã CK (F2) có dữ liệu giống với cell B3 của sheetcode là sheet1 (Sheet Loc)
.....
 
Do nhu cầu dữ liệu nhiều hơn (A2:J300000) và có thay đổi chút ít (em insert thêm cột) nên em đã thay đổi lại đoạn code của anh, nhưng không hiểu sao nó lại không chạy. Anh xem giúp em xem lỗi ở đâu anh nhé
[GPECODE=sql]Sub LocData()
Dim adoConn As Object, adoRS As Object
Set adoConn = CreateObject("ADODB.Connection")
Set adoRS = CreateObject("ADODB.Recordset")
With adoConn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
.Open
End With
With adoRS
.ActiveConnection = adoConn
.Open "select * from [DATA$A2:J300000] " _
& "where F2 like '" & Sheet1.Range("B3").Value & "' and " _
& "F1 between #" & Format(DateSerial(Year(Sheet1.[B2]), Month(Sheet1.[B2]), Day(Sheet1.[B2])), "mm/dd/yyyy") _
& "# AND #" & Format(DateSerial(Year(Sheet1.[d2]), Month(Sheet1.[d2]), Day(Sheet1.[d2])), "mm/dd/yyyy") & "# "
End With
With Sheet1
.[A7:J3000000].ClearContents
.[A7].CopyFromRecordset adoRS
End With
adoRS.Close: Set adoRS = Nothing
adoConn.Close: Set adoConn = Nothing

End Sub
Sub LocTop50()
LocDuyNhat
Dim adoConn As Object, adoRS As Object
Set adoConn = CreateObject("ADODB.Connection")
Set adoRS = CreateObject("ADODB.Recordset")
With adoConn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
.Open
End With
With adoRS
.ActiveConnection = adoConn
.Open "select * from [DATA$A2:J300000] " _
& "where F2 like '" & Sheet1.Range("M3").Value & "' and " _
& "F1 between #" & Format(DateSerial(Year(Sheet1.[M2]), Month(Sheet1.[M2]), Day(Sheet1.[M2])), "mm/dd/yyyy") _
& "# AND #" & Format(DateSerial(Year(Sheet1.[O2]), Month(Sheet1.[O2]), Day(Sheet1.[O2])), "mm/dd/yyyy") & "# "
End With
With Sheet1
.[L7:U300000].ClearContents
.[L7].CopyFromRecordset adoRS
End With
adoRS.Close: Set adoRS = Nothing
adoConn.Close: Set adoConn = Nothing

End Sub

Sub LocDuyNhat()
Dim adoConn As Object, adoRS As Object
Set adoConn = CreateObject("ADODB.Connection")
Set adoRS = CreateObject("ADODB.Recordset")
With adoConn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
.Open
End With
With adoRS
.ActiveConnection = adoConn
.Open "select distinct f2 " _
& "from [DATA$A2:J300000] " _
& "where F2 is not null "
End With
With Sheet2
.[B2:B300000].ClearContents
.[B2].CopyFromRecordset adoRS
.Range("B2:B" & .[B300000].End(xlUp).Row).Name = "MaCK"
End With
adoRS.Close
With adoRS
.ActiveConnection = adoConn
.Open "select distinct f1 " _
& "from [DATA$A2:J300000] " _
& "where F1 is not null" ' and f2 like '" & Sheet1.Range("B2").Value & "'"
End With
With Sheet2
.[C2:C300000].ClearContents
.[C2].CopyFromRecordset adoRS
.Range("C2:C" & .[C300000].End(xlUp).Row).Name = "Ngay"
End With
adoRS.Close: Set adoRS = Nothing
adoConn.Close: Set adoConn = Nothing

End Sub

[/GPECODE]
 

File đính kèm

DAOHUYENNEU đã viết:
Do nhu cầu dữ liệu nhiều hơn (A2:J300000) và có thay đổi chút ít (em insert thêm cột) nên em đã thay đổi lại đoạn code của anh, nhưng không hiểu sao nó lại không chạy. Anh xem giúp em xem lỗi ở đâu anh nhé
Nhấp chuột vào đây để mở rộng...
Anh Hai Lúa Miền Tây ơi, sửa giúp em đoạn code này với ạ. Em đnag ko biết là lỗi do đâu
 
DAOHUYENNEU đã viết:
Anh Hai Lúa Miền Tây ơi, sửa giúp em đoạn code này với ạ. Em đnag ko biết là lỗi do đâu
Nhấp chuột vào đây để mở rộng...
Tin buồn cho bạn là ADO trong Excel chỉ tham chiếu đến 65536 dòng, nếu dữ liệu bạn tham chiếu vượt qua số 65536 thì sẽ phát sinh lỗi. Chắc bác Bill khi nâng cấp từ Excel 2003->7->10->13 quên nâng cấp cái này.
 
Hai Lúa Miền Tây đã viết:
Tin buồn cho bạn là ADO trong Excel chỉ tham chiếu đến 65536 dòng, nếu dữ liệu bạn tham chiếu vượt qua số 65536 thì sẽ phát sinh lỗi. Chắc bác Bill khi nâng cấp từ Excel 2003->7->10->13 quên nâng cấp cái này.
Nhấp chuột vào đây để mở rộng...
Em cũng biết về giới hạn cột và dòng trong excel nhưng sao e thấy trong file của em vẫn dùng tham chiếu đến dòng 1048576 được mà???
 
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

thlpro
Cách lập Công thức tính số ngày nghỉ AL, ưu tiên tính 2024 trước rồi mới tính 2025 (3 người xem)
Trả lời
6
Đọc
89
ptm0412
ptm0412
N
Một ví dụ về XLL add-in: Tương tác với Google Gemini dưới dạng công thức bảng tính (1 người xem)
    • Thích
Trả lời
1
Đọc
167
thuytrangbp28
T
vsitcnh
Hỗ trợ công thức tính điểm dựa theo điều kiện. (1 người xem)
Trả lời
17
Đọc
271
tle2003
T
K
  • Question Question
nhờ ace giúp đỡ tự động filter và In hàng loạt từng mục trong piviot table (1 người xem)
Trả lời
4
Đọc
163
VetMini
V
G
Tách công thức ra khỏi chuỗi và tính kết quả? (1 người xem)
2
Trả lời
22
Đọc
2K
gobi
gobi
Trungvt3
Công thức trả về định dạng không như mong muốn và viết phân số trong 1 ô. (1 người xem)
Trả lời
5
Đọc
118
VetMini
V
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
16 17 18
Trả lời
346
Đọc
31K
Vandat1607
V
M
Xin giúp đỡ làm công thức điều kiện
Trả lời
2
Đọc
135
Hoangkhang01213
Hoangkhang01213
N
Khắc phục lỗi "The picture is too large and will be truncated"
Trả lời
10
Đọc
5K
tle2003
T
C
  • Question Question
Xin hỏi Cách viết chú thích trong vba hiển thị tiếng việt (1 người xem)
Trả lời
4
Đọc
183
ongke0711
ongke0711
B
Xin giải pháp chống sửa, xóa dữ liệu đã nhập vào từ ngày hôm trước.
    • Thích
2
Trả lời
28
Đọc
7K
Hoàng Tuấn 868
H
G
Xin Code xóa Module.
Trả lời
8
Đọc
309
huhumalu
H
00029591
Cần hỗ trợ công thức tổng hợp dữ liệu không cần cột phụ Vlookup (1 người xem)
Trả lời
3
Đọc
172
tle2003
T
D
  • Đã giải quyết
Quản lý email outlook qua VBA cần giúp đỡ (1 người xem)
2
Trả lời
22
Đọc
588
nguyendang95
N
S
Mở 2 cửa sổ riêng biệt
2
Trả lời
30
Đọc
23K
sakuraluu
S
F
Nhập dấu . (chấm) ở bàn phím phụ không tự chuyển thành dấu , (phẩy)
Trả lời
16
Đọc
57K
tubaodn21
tubaodn21
PhanTuHuong
Sách Lập trình VBA trong AutoCAD đã có mặt (1 người xem)
    • Thích
    • Yêu thích
2
Trả lời
21
Đọc
1K
PhanTuHuong
PhanTuHuong
L
Lỗi font khi convert từ pdf (1 người xem)
Trả lời
3
Đọc
151
lamvu0677
L
GPE-Trợ Lý
[GPE] TALKSHOW: PHÂN TÍCH BÁO CÁO ĐỘ NHẠY SỬ DỤNG EXCEL SOLVER (2 người xem)
    • Thích
Trả lời
0
Đọc
2K
GPE-Trợ Lý
GPE-Trợ Lý
K
Xin dax tính tỷ trọng doanh thu
Trả lời
18
Đọc
815
SteveNguyen1991
S
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
TALK SHOW: CÙNG NHẢY LAM BA ĐA VỚI HÀM LAMBDA (λ) EXCEL 365
Back
Top Bottom