Code lọc 3 điều kiện

Liên hệ QC

ngh_khanh

Thành viên mới
Tham gia
14/2/11
Bài viết
45
Được thích
25
Em có 1 ví dụ nhỏ thế này, nhờ AC thiết lập cho em code để nó lọc dư liệu sau khi thoả mãn 3 điều kiện.
Cám ơn AC nhiều!
 

File đính kèm

NHDK đã viết:
Anh ơi, anh nói rõ hơn chút nữa "CLng" nhé! Em không hiểu rõ chỗ này!?

Nói vầy chưa rõ sao?
ndu đã viết:
Clng([B2].Value)để biến giá tri cell B2 thành biến Long thôi mà anh

VBA co thể đọc hiểu ngày tháng của cell bất kỳ set Control Panel là kí rì, nhưng khi xử lý, nó luôn xử lý kiểu mm/dd/yyyy. Nếu cell A1 là 20/01/2011 và gán thisday = A1.Value, thì VBA có thể sẽ xử lý giá trị thisday là 20/1/2011 = 20/11 = 1,81818 hoặc 20/2011 = 0,009945 (bài toán chia)
Do đó chuyển Date thành Long, là 1 con số, VBA không thể hiện khác kiểu so với giá trị thực.

Tương tự, VBA thích hành sự theo ý mình là US, nên nếu muốn thể hiện số #.###,00 trong hệ thống dấu phảy thập phân, khi dùng VBA vẫn phải dùng lệnh:

[A1].Numberformat = "#,###.00"
 
Lần chỉnh sửa cuối:
Upvote 0
Em đã xem các ví dụ và có làm 1 file tương tự thế này. Nhưng hiện tại em vẫn chưa biết các bẫy lỗi. Nếu em muốn ô C4 nhập vào mà không đúng mã hàng thì nó sẽ thông báo: "Bạn nhâp chưa đúng. Hãy nhập lại!" thì em phải sửa code này như thế nào?
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    On Error Resume Next
    If Target.Address = "$C$4" Then
        Range("A7:E65000").ClearContents
        With S1.Range(S1.[A1], S1.[A65535].End(3)).Resize(, 7)
            .AutoFilter 2, ">=" & CLng(Range("C2").Value), 1, "<=" & CLng(Range("C3").Value)
            .AutoFilter 3, Range("C4").Value
            '2 dong sau co the viet thanh mot?
            .Resize(, 1).Offset(1, 0).SpecialCells(12).Copy Range("A7")
            .Offset(1, 3).Resize(, 4).SpecialCells(12).Copy Range("B7")
            .AutoFilter
        End With
    End If
End Sub
 

File đính kèm

Upvote 0
Câu bẫy lỗi thêm vào như sau:

Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    On Error Resume Next
    If Target.Address = "$C$4" Then
        [COLOR=red]If S1.Range(S1.[c1], S1.[c65535].End(3)).Find(Target) = 0 Then _
        MsgBox "hong co ma nay cha noi oi!": Exit Sub[/COLOR]
        Range("A7:E65000").ClearContents
        With S1.Range(S1.[A1], S1.[A65535].End(3)).Resize(, 7)
            .AutoFilter 2, ">=" & CLng(Range("C2").Value), 1, "<=" & CLng(Range("C3").Value)
            .AutoFilter 3, Range("C4").Value
            .Resize(, 1).Offset(1, 0).SpecialCells(12).Copy Range("A7")
            .Offset(1, 3).Resize(, 4).SpecialCells(12).Copy Range("B7")
            .AutoFilter
        End With
    End If
End Sub
 
Upvote 0
Câu bẫy lỗi thêm vào như sau:

Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
On Error Resume Next
If Target.Address = "$C$4" Then
[COLOR=red]If S1.Range(S1.[c1], S1.[c65535].End(3)).Find(Target) = 0 Then _
MsgBox "hong co ma nay cha noi oi!": Exit Sub[/COLOR]
Range("A7:E65000").ClearContents
With S1.Range(S1.[A1], S1.[A65535].End(3)).Resize(, 7)
.AutoFilter 2, ">=" & CLng(Range("C2").Value), 1, "<=" & CLng(Range("C3").Value)
.AutoFilter 3, Range("C4").Value
.Resize(, 1).Offset(1, 0).SpecialCells(12).Copy Range("A7")
.Offset(1, 3).Resize(, 4).SpecialCells(12).Copy Range("B7")
.AutoFilter
End With
End If
End Sub

Sư phụ ơi, 2 dòng này có thế viết gộp lại:
PHP:
.Resize(, 1).Offset(1, 0).SpecialCells(12).Copy Range("A7")
.Offset(1, 3).Resize(, 4).SpecialCells(12).Copy Range("B7")
được không ah?
 
Upvote 0
Sư phụ ơi, 2 dòng này có thế viết gộp lại:
PHP:
.Resize(, 1).Offset(1, 0).SpecialCells(12).Copy Range("A7")
.Offset(1, 3).Resize(, 4).SpecialCells(12).Copy Range("B7")
được không ah?
Được thì vẫn được, dùng Union, nhưng không đáng công.

PHP:
Union(.Resize(, 1).Offset(1, 0).SpecialCells(12), .Offset(1, 3).Resize(, 4).SpecialCells(12)).Copy Range("A7")
 
Upvote 0
Được thì vẫn được, dùng Union, nhưng không đáng công.

PHP:
Union(.Resize(, 1).Offset(1, 0).SpecialCells(12), .Offset(1, 3).Resize(, 4).SpecialCells(12)).Copy Range("A7")
Hổng biết đặt thằng SpecialCells(12) ra ngoài làm "thừa số chung" được không ta???
 
Upvote 0
Upvote 0
thử phát biết liền:
PHP:
Union(.Resize(, 1).Offset(1, 0), .Offset(1, 3).Resize(, 4)).SpecialCells(12).Copy Range("A7")
Kết quả: OK
Thấy tác giả topic này tiếp thu tốt và chắc chắn là VBA cũng năm khá. Vậy sao kg hướng theo array, thú thật dùng for và array có khi còn dễ hiểu hơn.
Vậy mà 2 Thầy PTM và NDU cùng nhau làm theo hướng AutoFilter.
Vậy nhờ 2 Thầy PTM và NDU giúp em vấn đề em đang bí với. Chắc chắn là PTM và NDU sẽ có hướng.
Link sau. ConvertExToFox
http://www.giaiphapexcel.com/forum/showthread.php?44987-Đưa-dữ-liệu-từ-excel-vào-fox!
Cám ơn nhé.
Hậu tạ 2 Thầy 1 cây Con mèo.
 
Lần chỉnh sửa cuối:
Upvote 0
Thấy tác giả topic này tiếp thu tốt và chắc chắn là VBA cũng năm khá. Vậy sao kg hướng theo array, thú thật dùng for và array có khi còn dễ hiểu hơn.
Vậy mà 2 Thầy PTM và NDU cùng nhau làm theo hướng AutoFilter.
Vậy nhờ 2 Thầy PTM và NDU giúp em vấn đề em đang bí với. Chắc chắn là PTM và NDU sẽ có hướng.
Link sau. ConvertExToFox
http://www.giaiphapexcel.com/forum/showthread.php?44987-%C4%90%C6%B0a-d%E1%BB%AF-li%E1%BB%87u-t%E1%BB%AB-excel-v%C3%A0o-fox!
Cám ơn nhé.
Hậu tạ 2 Thầy 1 cây Con mèo.
Chỉ là tham khảo thôi mà ---> Ít ra với AutoFilter thì ta còn làm bằng tay được (chỉ viết lại cho ra vẽ tự động thôi)
Còn cái thăng ConvertExToFox thì... tiếc quá, có biết gì về "con cáo" đâu mà giúp (mất cha nó con mèo rồi)
 
Upvote 0
Chỉ là tham khảo thôi mà ---> Ít ra với AutoFilter thì ta còn làm bằng tay được (chỉ viết lại cho ra vẽ tự động thôi)
Còn cái thăng ConvertExToFox thì... tiếc quá, có biết gì về "con cáo" đâu mà giúp (mất cha nó con mèo rồi)
NDU chuyên nghiên cứu mà, nghiên cứu giúp mình với, chớ mình có biết gì về con cáo đâu, chỉ biết con cầy thôi. Vì có dùng PM bằng Fox mà phần nhập liệu mất công quá nên muốn tham gia để có thể nhập = Ex, thời gian dư để làm vài ve.
 
Upvote 0
Thấy tác giả topic này tiếp thu tốt và chắc chắn là VBA cũng năm khá. Vậy sao kg hướng theo array, thú thật dùng for và array có khi còn dễ hiểu hơn.
Vậy mà 2 Thầy PTM và NDU cùng nhau làm theo hướng AutoFilter.
Vậy nhờ 2 Thầy PTM và NDU giúp em vấn đề em đang bí với. Chắc chắn là PTM và NDU sẽ có hướng.
Link sau. ConvertExToFox
http://www.giaiphapexcel.com/forum/showthread.php?44987-Đưa-dữ-liệu-từ-excel-vào-fox!
Cám ơn nhé.
Hậu tạ 2 Thầy 1 cây Con mèo.

Thực ra về mảng em vẫn kém lắm! Em biết mảng rất hay với dữ liệu nhiều! Em đang tìm hiểu. Nhở các AC chỉ thêm nữa.
 
Upvote 0
Thực ra về mảng em vẫn kém lắm! Em biết mảng rất hay với dữ liệu nhiều! Em đang tìm hiểu. Nhở các AC chỉ thêm nữa.
Mảng cũng như set range, range sao thì mảng vậy.
VD:
Dim MyRng as range
Set MyRng=Range("A1:B10")
'Gồm 10 dòng và 2 cột'
For iR =1 to 10
For iC=1 to 2
'iF MyRng(iR,iC) ="..." then ...'
Next iC
Next iR

Dim MyArr
MyArr=Range("A1:B10")
'Gồm 10 dòng và 2 cột'
For iR =1 to 10
For iC=1 to 2
'iF MyArr(iR,iC) ="..." then ...'
Next iC
Next iR
Cố gắng, dùng cơ bản vòng lặp sẽ dễ triển khai hơn, nó giống như hiểu sao làm vậy, duyệt qua từng dòng, nếu dòng nào có cột nào thỏa yêu cầu thì lấy.
Range thì phải gán kết quả vào Sh khi thỏa yêu cầu.
Mảng thì lấy kết quả xong mới gán vào sh.
 
Upvote 0
Web KT

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

Back
Top Bottom