Code lọc dữ liệu
- Thread starter NH_DK
- Ngày gửi
MinhCong
Thành viên gắn bó
- Tham gia
- 28/5/09
- Bài viết
- 1,645
- Được thích
- 1,806
- Nghề nghiệp
- Xây dựng Cầu đường
Bạn dùng AutoFilter để lọc nhé!
Mã:
Sub Locdulieu()
Dim enR As Long
Range("A3:D65536").Clear
enR = Sheets("Data").[A65536].End(xlUp).Row
With Sheets("Data").Range("A1:A" & enR).Resize(, 4)
.AutoFilter Field:=3, Criteria1:=Range("E1")
.SpecialCells(xlCellTypeVisible).Copy Range("A3")
.AutoFilter
End With
Range([a4], [a4].End(xlDown)) = [row(a:a)]
End Sub
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,930
Nói thiệt, bài này mà dùng PivotTable mới là nhanh và chuẩn nhất
Còn muốn code kiết gì đó, cứ dùng AutoFilter hoặc Advanced Filter mà làm ---> Record macro quá trình lọc rồi xem và chỉnh lại code
------------
Bạn MinhCong nếu dùng Sub để lọc thì phải thật chú ý vùng dữ liệu: Phải chỉ chính xác vùng dữ liệu ấy nằm tại sheet nào, nếu không thì hậu quả có thể không lường trước được! Ví dụ đứng tại sheet Data mà chạy code thì sao?
Ngoài ra code của bạn còn 1 lỗi rất nặng khi dùng End(xlDown) ---> Nếu MÃ không tồn tại thì.... Ẹc... Ẹc...
Lần chỉnh sửa cuối:
Upvote
0
NH_DK
Let's patience
- Tham gia
- 29/7/10
- Bài viết
- 865
- Được thích
- 1,203
- Nghề nghiệp
- Kế toán
Thưa thầy, thú thật việc chỉnh code của em vẫn còn yếu lắm. Thu thì em có thể làm được. Nhưng sửa cho gọn hơn thì..........vẫn abc lắm thầy ơi. Hu hu.........
Em cũng đang cố để học ah!
Xin thầy tư vấn thêm. Thầy có thể viết dùm em code tối ưu hơn? Em tạo ví dụ này để học mà.
Upvote
0
MinhCong
Thành viên gắn bó
- Tham gia
- 28/5/09
- Bài viết
- 1,645
- Được thích
- 1,806
- Nghề nghiệp
- Xây dựng Cầu đường
Theo sự góp ý của anh NDU mình sửa lại code như sau:
Mã:
Sub Locdulieu()
Dim enR As Long
Sheets("Loc").Range("A3:D65536").Clear
enR = Sheets("Data").[a65536].End(xlUp).Row
With Sheets("Data").Range("A1:A" & enR).Resize(, 4)
.AutoFilter Field:=3, Criteria1:=Sheets("Loc").Range("E1")
.SpecialCells(12).Copy Sheets("Loc").Range("A3")
.AutoFilter
End With
Sheets("Loc").Range(Sheets("Loc").[a4], Sheets("Loc").[a65536].End(xlUp)) = Sheets("Loc").[row(a:a)]
End Sub
Upvote
0
concogia
Gội rồi mới Cạo
- Tham gia
- 17/9/09
- Bài viết
- 3,412
- Được thích
- 6,874
Theo mình, bài này đưa vào sự kiện của sheet
Ở sheet LOC bạn í đâu cần cột Mã HH đâu Minhcong
Trường hợp không có Mã như Thầy Ndu nói thật sự khó xảy ra vì:
- Tạo validation ngay cell nhập điều kiện lọc :100% không xảy ra việc này
- Nếu không có validation ở cell đó ta phải bẫy lỗi ngay ở đoạn đầu của code
Code ở dưới dùng XlDown, Xlup đều không có vấn đề gì
Code này không tối ưu hay sáng ưu nhưng đáp ứng yêu cầu của bài
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Vung As Range, Ws As Worksheet
Set Ws = Sheets("data")
Set Vung = Ws.Range(Ws.[b1], Ws.[b1000].End(xlUp))
If Target.Address = "$E$1" Then
[a1].CurrentRegion.Clear
If Application.WorksheetFunction.CountIf(Vung.Offset(0, 1), Target.Value) = 0 Then MsgBox ("Không có MHH này"): Exit Sub
With Vung
.Offset(0, -1).Resize(, 4).AutoFilter 3, [e1]
.Offset(0, 1).EntireColumn.Hidden = True
.Offset(0, -1).Resize(, 4).SpecialCells(12).Copy [a1]
.AutoFilter
End With
Ws.Cells.EntireColumn.Hidden = False
Range([a2], [a2].End(xlDown)) = [row(A:A)]
End If
End Sub
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,930
Ít ra củng phải vầy:
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$1" Then
Range("A:C").Clear
With Sheets("Data")
With .Range("A1").CurrentRegion
.AutoFilter 3, Target
Union(.Resize(, 2), .Resize(, 1).Offset(, 3)).SpecialCells(12).Copy Range("A1")
.AutoFilter
End With
End With
With Range("A1").CurrentRegion
If .Rows.Count > 1 Then _
Intersect(.Cells, .Offset(1)).Resize(, 1) = Evaluate("ROW(R:R)")
End With
End If
End Sub
Lần chỉnh sửa cuối:
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,930
Cách khác
Gữi bạn thêm 1 cách khác: Lọc bằng ComboBox, trong đó có nạp list tự động cho ComboBox (đở tốn công gõ)
Xem và cảm nhận nhé
Gữi bạn thêm 1 cách khác: Lọc bằng ComboBox, trong đó có nạp list tự động cho ComboBox (đở tốn công gõ)
PHP:
Private Sub ComboBox1_Click()
Range("A:C").Clear
With Sheets("Data").Range("A1").CurrentRegion
.AutoFilter 3, ComboBox1.Text
Union(.Resize(, 2), .Resize(, 1).Offset(, 3)).SpecialCells(12).Copy Range("A1")
.AutoFilter
End With
With Range("A1").CurrentRegion
If .Rows.Count > 1 Then _
Intersect(.Cells, .Offset(1)).Resize(, 1) = Evaluate("ROW(R:R)")
End With
End Sub
PHP:
Private Sub ComboBox1_DropButtonClick()
With Sheets("Data").Range("A1").CurrentRegion
ComboBox1.List() = UniqueList(Intersect(.Cells, .Offset(1, 2)).Resize(, 1))
End With
End Sub
PHP:
Private Function UniqueList(sArray)
Dim Tmp, Item
Tmp = sArray
With CreateObject("Scripting.Dictionary")
For Each Item In Tmp
If Item <> "" And Not .Exists(CStr(Item)) Then
.Add Item, ""
End If
Next
UniqueList = .Keys
End With
End Function
Upvote
0
thanhlp2007
Thành viên thường trực
- Tham gia
- 24/10/07
- Bài viết
- 201
- Được thích
- 11
Để chạy ọoạn code đó thì mình làm sao để lọc vậy các AC. Mình mù về VBA lắm
Mong chỉ giúp
Mong chỉ giúp
Upvote
0
