Rút gọn Code (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)
Cá ngừ F1

Cá ngừ F1

( ͡° ͜ʖ ͡°)
Thành viên BQT
Moderator
Tham gia
1/1/08
Bài viết
2,579
Được thích
3,723
Donate (Momo)
Donate
Giới tính
Nam
Nghề nghiệp
Quan hệ.. và quan hệ..
E có dùng công cụ Advance Filter để tạo ra khá nhiều nút lệnh, trong module có code sau:
Mã: 
Sub overdue()
    With Sheets("report")
    Sheets("report").Unprotect
        Range("C6:M10000").Clear
            Range("data").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
        ("quahan"), CopyToRange:=Sheets("report").Range("C5:M5"), Unique:=False
    Sheets("report").Protect
    End With
End Sub
Sub Cbal()
    With Sheets("report")
        Sheets("report").Unprotect
        Range("C6:M10000").Clear
        Range("data").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
        ("Cbal"), CopyToRange:=Sheets("report").Range("C5:M5"), Unique:=False
        Sheets("report").Protect
    End With
End Sub
Sub no_active()
    With Sheets("report")
        Sheets("report").Unprotect
        Range("C6:M10000").Clear
        Range("data").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
        ("no_active"), CopyToRange:=Sheets("report").Range("C5:M5"), Unique:=False
        Sheets("report").Protect
    End With
End Sub
Sub giahan()
    With Sheets("report")
        Sheets("report").Unprotect
        Range("C6:M10000").Clear
    Range("data").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
        ("giahan"), CopyToRange:=Sheets("report").Range("C5:M5"), Unique:=False
    Sheets("report").Protect
    End With
End Sub
Sub no_number()
    With Sheets("report")
        Sheets("report").Unprotect
        Range("C6:M10000").Clear
    Range("data").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
        ("no_number"), CopyToRange:=Sheets("report").Range("C5:M5"), Unique:=False
    Sheets("report").Protect
    End With
End Sub
E thấy các câu lệnh đều giống nhau.. chỉ có mỗi CriteriaRange là khác nhau... Vậy có cách nào để rút ngắn các Code này lại không (hoặc có cách nào hay hơn).. vì có thể sẽ phải thêm nhiều CriteriaRange nữa ạh
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Cá ngừ F1 đã viết:
E có dùng công cụ Advance Filter để tạo ra khá nhiều nút lệnh, trong module có code sau:
Mã: 
Sub overdue()
    With Sheets("report")
    Sheets("report").Unprotect
        Range("C6:M10000").Clear
            Range("data").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
        ("quahan"), CopyToRange:=Sheets("report").Range("C5:M5"), Unique:=False
    Sheets("report").Protect
    End With
End Sub
Sub Cbal()
    With Sheets("report")
        Sheets("report").Unprotect
        Range("C6:M10000").Clear
        Range("data").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
        ("Cbal"), CopyToRange:=Sheets("report").Range("C5:M5"), Unique:=False
        Sheets("report").Protect
    End With
End Sub
Sub no_active()
    With Sheets("report")
        Sheets("report").Unprotect
        Range("C6:M10000").Clear
        Range("data").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
        ("no_active"), CopyToRange:=Sheets("report").Range("C5:M5"), Unique:=False
        Sheets("report").Protect
    End With
End Sub
Sub giahan()
    With Sheets("report")
        Sheets("report").Unprotect
        Range("C6:M10000").Clear
    Range("data").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
        ("giahan"), CopyToRange:=Sheets("report").Range("C5:M5"), Unique:=False
    Sheets("report").Protect
    End With
End Sub
Sub no_number()
    With Sheets("report")
        Sheets("report").Unprotect
        Range("C6:M10000").Clear
    Range("data").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
        ("no_number"), CopyToRange:=Sheets("report").Range("C5:M5"), Unique:=False
    Sheets("report").Protect
    End With
End Sub
E thấy các câu lệnh đều giống nhau.. chỉ có mỗi CriteriaRange là khác nhau... Vậy có cách nào để rút ngắn các Code này lại không (hoặc có cách nào hay hơn).. vì có thể sẽ phải thêm nhiều CriteriaRange nữa ạh
Nhấp chuột vào đây để mở rộng...
Không có file cũng hơi khó biết cách rút nó lại cho gọn
Nhưng theo mình thi tại sheet report tạo 1 datavalidation rồi dùng sự kiện change để chạy code lọc, đieu kien lọc thì lấy tại ô target
 
Lần chỉnh sửa cuối:
Upvote 0
Thử dùng 1 biến cho CriteriaRange xem.
 
Upvote 0
quanghai1969 đã viết:
Không có file cũng hơi khó biết cách rút nó lại cho gọn
Nhưng theo mình thi tại sheet report tạo 1 datavalidation rồi dùng sự kiện change để chạy code lọc, đieu kien lọc thì lấy tại ô target
Nhấp chuột vào đây để mở rộng...
CriteriaRange gồm 2 dòng, 1 dòng tiêu đề và 1 dòng điều kiện lọc. Và có thể nhiều hơn 1 cột, Không thể dùng validation.
 
Upvote 0
ptm0412 đã viết:
CriteriaRange gồm 2 dòng, 1 dòng tiêu đề và 1 dòng điều kiện lọc. Và có thể nhiều hơn 1 cột, Không thể dùng validation.
Nhấp chuột vào đây để mở rộng...
Em cũng biết điều này, bởi vậy phải cần có file mới biết nên điều chỉnh thể nào cho hợp lý. Nếu cần thì mình dùng vòng lặp để lấy dữ liệu luôn.
 
Upvote 0
Upvote 0
Dạ..a đợi e xào xáo lên tí..vì thông tin có liên quan đến công việc..khá bảo mật.. A thấy điều kiện lọc đó.. Nào quá hạn.. Dư nợ.. Ko thể đưa lên ạh.. Mà xào xáo đi thì form lại thay đổi hết cả..hjk
 
Upvote 0
Cá ngừ F1 đã viết:
E có dùng công cụ Advance Filter để tạo ra khá nhiều nút lệnh, trong module có code sau:
Mã: 
Sub overdue()
    With Sheets("report")
    Sheets("report").Unprotect
        Range("C6:M10000").Clear
            Range("data").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
        ("quahan"), CopyToRange:=Sheets("report").Range("C5:M5"), Unique:=False
    Sheets("report").Protect
    End With
End Sub
.....
E thấy các câu lệnh đều giống nhau.. chỉ có mỗi CriteriaRange là khác nhau... Vậy có cách nào để rút ngắn các Code này lại không (hoặc có cách nào hay hơn).. vì có thể sẽ phải thêm nhiều CriteriaRange nữa ạh
Nhấp chuột vào đây để mở rộng...
Thì tạo 1 sub có tham số truyền để tùy biến
Chẳng hạn:
Mã: 
Sub MultiAF(ByVal Criteria As Range)
  With Sheets("report")
    .Unprotect
    [COLOR=#ff0000]Range("C6:M10000")[/COLOR].Clear
    [COLOR=#ff0000]Range("data")[/COLOR].AdvancedFilter 2, Criteria, .Range("C5:M5")
    .Protect
  End With
End Sub
Và sub chính để chạy sẽ là
Mã: 
Sub Main()
  MultiAF Range("[COLOR=#0000cd]quahan[/COLOR]")  ''<--- Chổ này phải ghi tên sheet đàng hoàng
'  hoăc MultiAF Range("[COLOR=#0000cd]Cbal[/COLOR]")
'  hoăc MultiAF Range("[COLOR=#0000cd]no_active[/COLOR]")
'  hoăc MultiAF Range("[COLOR=#0000cd]giahan[/COLOR]")
'  hoăc MultiAF Range("[COLOR=#0000cd]no_number[/COLOR]")
End Sub
Lưu ý:
- Chổ màu đỏ bạn phải ghi rõ tên sheet, nếu không thì khi đứng ở 1 sheet khác để chạy sẽ báo lỗi (tức là code hiện tại chỉ chạy được khi bạn đứng ở 1 sheet nhất định)
- 5 cái tên màu xanh ấy bạn có thể cho nó vào 1 validation list để gọi sub cho tiện. Chẳng hạn Validation đã có tại B2 thì ta có thể viết code cho sự kiện Change như sau:
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$B$2" Then MultiAF Range(Target.Value)
End Sub
Hàng đống cách
 
Upvote 0
Code chung:

PHP: 
Sub AdvFilter(CritRng As Range)
    With Sheets("report")
    Sheets("report").Unprotect
        Range("C6:M10000").Clear
            Range("data").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=CritRng, _
            CopyToRange:=Sheets("report").Range("C5:M5"), Unique:=False
    Sheets("report").Protect
    End With
End Sub

Code 1 (mẫu), các code khác tương tự:

PHP: 
Sub AdvFlt1()
   AdvFilter Sheets("Data").Range("no_active")
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
ptm0412 đã viết:
Code chung:

PHP: 
Sub AdvFilter(CritRng As Range)
    With Sheets("report")
    Sheets("report").Unprotect
        Range("C6:M10000").Clear
            Range("data").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=CritRng, _
            CopyToRange:=Sheets("report").Range("C5:M5"), Unique:=False
    Sheets("report").Protect
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Bác Ptm0412 chắc viết vội nên cho With...End With nhưng lại quên "."
PHP: 
Sub AdvFilter(CritRng As Range)
With Sheets("report")      
  .Unprotect
  Range("C6:M10000").Clear           
  Range("data").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=CritRng, _            
                CopyToRange:=.Range("C5:M5"), Unique:=False      
  .Protect    
End With
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
hoi_joker84 đã viết:
Bác Ptm0412 chắc viết vội nên cho With...End With nhưng lại quên "."
Nhấp chuột vào đây để mở rộng...

Code đó là nguyên văn code của chủ topic, chỉ thay tên biến vào. Code đã chạy được thì để nguyên văn.
Đoán chừng tác giả đang đứng ở sheet "Data" chạy code. Và nếu chấm chiếc thì phải thế này:
Mã: 
Sub AdvFilter(CritRng As Range)
With Sheets("report")      
  .Unprotect
 [COLOR=#ff0000] .Range[/COLOR]("C6:M10000").Clear           
  Range("data").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=CritRng, _            
                CopyToRange:=.Range("C5:M5"), Unique:=False      
  .Protect    
End With
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
ndu96081631 đã viết:
Thì tạo 1 sub có tham số truyền để tùy biến
Chẳng hạn:
Mã: 
Sub MultiAF(ByVal Criteria As Range)
  With Sheets("report")
    .Unprotect
    [COLOR=#ff0000]Range("C6:M10000")[/COLOR].Clear
    [COLOR=#ff0000]Range("data")[/COLOR].AdvancedFilter 2, Criteria, .Range("C5:M5")
    .Protect
  End With
End Sub
Và sub chính để chạy sẽ là
Mã: 
Sub Main()
  MultiAF Range("[COLOR=#0000cd]quahan[/COLOR]")  ''<--- Chổ này phải ghi tên sheet đàng hoàng
'  hoăc MultiAF Range("[COLOR=#0000cd]Cbal[/COLOR]")
'  hoăc MultiAF Range("[COLOR=#0000cd]no_active[/COLOR]")
'  hoăc MultiAF Range("[COLOR=#0000cd]giahan[/COLOR]")
'  hoăc MultiAF Range("[COLOR=#0000cd]no_number[/COLOR]")
End Sub
Lưu ý:
- Chổ màu đỏ bạn phải ghi rõ tên sheet, nếu không thì khi đứng ở 1 sheet khác để chạy sẽ báo lỗi (tức là code hiện tại chỉ chạy được khi bạn đứng ở 1 sheet nhất định)
- 5 cái tên màu xanh ấy bạn có thể cho nó vào 1 validation list để gọi sub cho tiện. Chẳng hạn Validation đã có tại B2 thì ta có thể viết code cho sự kiện Change như sau:
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$B$2" Then MultiAF Range(Target.Value)
End Sub
Hàng đống cách
Nhấp chuột vào đây để mở rộng...

Ở Module e viết code:
Mã: 
Sub MultiAF(ByVal Criteria As Range)
  With Sheets("report")
    .Unprotect
    Sheets("report").Range("C6:M10000").Clear
    Sheets("data").Range("data").AdvancedFilter 2, Criteria, .Range("C5:M5")
    .Protect
  End With
End Sub
Sub main()
    MultiAF Sheets("report").Range("[COLOR=#ff0000]M1[/COLOR]")     '[COLOR=#ff0000]M1 của sheet Report có validation như: Cbal, quahan...[/COLOR]
End Sub
Ở sheet Report e viết code:
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "[COLOR=#ff0000]M1[/COLOR]" Then MultiAF Range(Target.Value)
End Sub
Code này sai chỗ nào mà e test như hướng dẫn (thay đổi vali ở M1) mà toàn ra tất cả các bản ghi
 
Upvote 0
Cá ngừ F1 đã viết:
Ở Module e viết code:
Mã:
Ở sheet Report e viết code:
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "[COLOR=#ff0000]$M$1[/COLOR]" Then MultiAF Range(Target.Value)
End Sub
Code này sai chỗ nào mà e test như hướng dẫn (thay đổi vali ở M1) mà toàn ra tất cả các bản ghi
Nhấp chuột vào đây để mở rộng...
Sơ sơ là thấy sai chỗ M1 rồi. Thử thêm dấu $ vào xem sao
 
Upvote 0
Bạn thử tạo biến dùng chung, kiểu như ở dưới. Kiểm tra kỹ sợ có đoạn nào chưa sửa hết:

Mã: 
Sub DungChung(NameRange As Name)
    With Sheets("report")
        Sheets("report").Unprotect
            Range("C6:M10000").Clear
            Range("data").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
            ("NameRange"), CopyToRange:=Sheets("report").Range("C5:M5"), Unique:=False
        Sheets("report").Protect
    End With
End Sub

Sub overdue()
    Call DungChung("quahan")
End Sub

Sub Cbal()
    Call DungChung("Cbal")
End Sub

Sub no_active()
    Call DungChung("no_active")
End Sub

Sub giahan()
    Call DungChung("giahan")
End Sub

Sub no_number()
    Call DungChung("no_number")
End Sub
 
Upvote 0
Cá ngừ F1 đã viết:
Ở Module e viết code:
Mã: 
Sub MultiAF(ByVal Criteria As Range)
  With Sheets("report")
    .Unprotect
    Sheets("report").Range("C6:M10000").Clear
    Sheets("data").Range("data").AdvancedFilter 2, Criteria, .Range("C5:M5")
    .Protect
  End With
End Sub
Sub main()
    MultiAF Sheets("report").Range("[COLOR=#ff0000]M1[/COLOR]")     '[COLOR=#ff0000]M1 của sheet Report có validation như: Cbal, quahan...[/COLOR]
End Sub
Ở sheet Report e viết code:
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "[COLOR=#ff0000]M1[/COLOR]" Then MultiAF Range(Target.Value)
End Sub
Code này sai chỗ nào mà e test như hướng dẫn (thay đổi vali ở M1) mà toàn ra tất cả các bản ghi
Nhấp chuột vào đây để mở rộng...

Chổ này: MultiAF Sheets("report").Range("M1") ---> SAI
Cái bạn cần là Range("Cbal"), Range("quahan")... chứ đâu phải Range("M1")
Vậy phải sửa thành: MultiAF Sheets("report").Range(Sheets("report").Range("M1").Value) mới đúng
Chổ này If Target.Address = "M1" cũng sai luôn
Address luôn trả về kết quả là địa chỉ tuyệt đối (có dấu $)
 
Upvote 0
ndu96081631 đã viết:
Chổ này: MultiAF Sheets("report").Range("M1") ---> SAI
Cái bạn cần là Range("Cbal"), Range("quahan")... chứ đâu phải Range("M1")
Vậy phải sửa thành: MultiAF Sheets("report").Range(Sheets("report").Range("M1").Value) mới đúng
Chổ này If Target.Address = "M1" cũng sai luôn
Address luôn trả về kết quả là địa chỉ tuyệt đối (có dấu $)
Nhấp chuột vào đây để mở rộng...
Dạ...cảm ơn thày.. E đã biết lỗi ở đâu rùi ạh...
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

B
Sau 1 tháng Mã Lại reset về 1 trở lên (4 người xem)
Trả lời
13
Đọc
129
ongke0711
ongke0711
N
  • Question Question
Cho em hỏi về mail merge bằng vba (2 người xem)
Trả lời
5
Đọc
113
Hoàng Tuấn 868
H
T
Khóa cột cập nhật dữ liệu (2 người xem)
Trả lời
0
Đọc
27
tnkhanhvy
T
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (3 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
3 4 5
Trả lời
411
Đọc
50K
ongke0711
ongke0711
H
Đánh số thứ thự phiếu thu chi
Trả lời
11
Đọc
169
HangktGTN
H
H
Tìm kiếm thông tin chi tiết trên sheet tổng hợp (1 người xem)
Trả lời
1
Đọc
55
LOGANWover
L
T
Xin hỏi về bảng lương
Trả lời
0
Đọc
56
tuandovn
T
Gà Công Nghệ
Tô màu họ và tên bị trùng từ 2 sheet khác nhau
Trả lời
6
Đọc
115
Gà Công Nghệ
Gà Công Nghệ
A
  • Question Question
Giải thích giúp mình code giải phóng bộ nhớ từ biến (1 người xem)
Trả lời
20
Đọc
9K
nguyendang95
N
Nguyenkhang2404
giúp đỡ lọc dữ liệu nâng cao
Trả lời
22
Đọc
733
Phan Thế Hiệp
Phan Thế Hiệp
B
Dùng button trên forrm để gọi bàn phím ảo win 10(OSK)
Trả lời
5
Đọc
124
huhumalu
H
P
VẼ ĐƯỜNG TẦN SUẤT (DTS) TRÊN EXCEL
Trả lời
8
Đọc
197
ptm0412
ptm0412
P
GOAL SEEK NÂNG CAO TRONG EXCEL (1 người xem)
    • Thích
Trả lời
4
Đọc
210
Hoale85
H
B
Gán Phím Tắt Gọi Form (2 người xem)
Trả lời
7
Đọc
112
HeSanbi
HeSanbi
K
Điền giá trị ô thay vì địa chỉ ô
Trả lời
2
Đọc
129
LOGANWover
L
G
Chia sẻ các bạn File vẽ kèo Zamil từ excel
    • Thích
    • Yêu thích
Trả lời
11
Đọc
919
trqt82
T
T
Xin trợ giúp cách lọc trùng về khoảng thời gian (1 người xem)
Trả lời
10
Đọc
2K
Phan Thế Hiệp
Phan Thế Hiệp
L
Xin hàm trích xuất chuỗi trong ô
Trả lời
12
Đọc
213
LINH7979
L
H
[Xin giúp đỡ] Tìm thời gian trùng ở nhiều khoảng thời gian khác nhau. (1 người xem)
Trả lời
14
Đọc
2K
Phan Thế Hiệp
Phan Thế Hiệp
N
Thuế thu nhập cá nhân
    • Chấp nhận
Trả lời
3
Đọc
277
ngouyen1505
N
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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom