Gỡ rối đoạn code xóa .ClearContents (1 người xem)

[KhoiSMC]

Mình dùng đoạn mã sau để thực hiện lọc AdvancedFilter,

Private Sub Worksheet_Change(ByVal Target As Range)
With Application
.ScreenUpdating = False
.EnableEvents = False

If Not Intersect(Target, [A4:C4]) Is Nothing Then
On Error Resume Next
ActiveSheet.ShowAllData
Range("A3", Range("C1000").End(xlUp)).AdvancedFilter 2, Range("A3:C4"), Range("E3:G1000"), Unique:=False
End If

.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Kết quả là:



Mình nhờ các bạn tư vấn giúp dùng hàm

Worksheets("Sheet1").Range("E5:G1000").ClearContents

Đặt code trên ở đâu để khi điều kiện lọc Target, [A4:C4] để trống/bị xóa trống (như hình ảnh trên) thì vùng E5:G1000 được làm sạch. có nghĩa là khi A4:C4 có điều kiện lọc thì mới hiện kết quả ở E5:G1000 còn để trống thì vùng E5:G1000 cũng phải trống.

Thanks
Khoi

 

[phucbugis]

Mình dùng đoạn mã sau để thực hiện lọc AdvancedFilter,
...
Khoi

bạn tải file đính kèm về xem sao nhé !
(khi bạn viết code cho AdvFilter thì nên viết rõ các điều kiện ra )

 

[KhoiSMC]

Cám ơn bạn,

Mình mới tập tọe vào VBA nên còn nhiều bỡ ngỡ. Đúng là nhìn cấu trúc lệnh của bạn rõ ràng hơn hẳn.

Thanks
Khoi

 

[KhoiSMC]

Hi phucbugis,

Cũng file đính kèm ở bài #2 của bạn, mình muốn chuyển như sau:
- Sheet1: Nới chứa dữ liệu
- Sheet2: Nơi để điều kiện lọc và hiện kết quả lọc, cụ thể:
CriteriaRange:= Worksheets("Sheet2").Range("A1:C2")
và
CopyToRange:=Worksheets("Sheet2").Range("E4:G4")

Thì sửa đoạn code tại #2 như thế nào bạn?

Thanks
Khoi

 

[phucbugis]

Hi phucbugis,
Cũng file đính kèm ở bài #2 của bạn, mình muốn chuyển như sau:
- Sheet1: Nới chứa dữ liệu
- Sheet2: Nơi để điều kiện lọc và hiện kết quả lọc, cụ thể:
CriteriaRange:= Worksheets("Sheet2").Range("A1:C2")
và
CopyToRange:=Worksheets("Sheet2").Range("E4:G4")

Thì sửa đoạn code tại #2 như thế nào bạn?
Thanks
Khoi

bạn dùng đoạn code sau cho module Sheet2
[GPECODE=vb]
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vung As Range

With Application
.ScreenUpdating = False
.EnableEvents = False

If Not Intersect(Target, Range("A2:C2")) Is Nothing Then
If Application.WorksheetFunction.CountBlank([A2:C2]) = 3 Then
Worksheets("Sheet2").Range("E5:G1000").ClearContents
Else
With Sheets("Sheet1")
'co' 3 dau' . dat truoc' Range (do dung` with ... end with)
Set vung = .Range(.Range("A65000").End(xlUp), .Range("C4"))
End With
'hoac Set vung = Sheets("Sheet1").Range(Sheets("Sheet1").Range("A65000").End(xlUp), Sheets("Sheet1").Range("C4"))

'dkien CopyToRange <=> header cua Sheet2
vung.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("A1:C2"), _
CopyToRange:=Range("E4:G4"), _
Unique:=False

Set vung = Nothing
End If
End If

.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
[/GPECODE]

- mình có thay đổi code xác định vùng hơi khác so với code cũ bạn 1 tí.
- khi xác định theo kiểu xlUp thì số liệu cột Title1 luôn luôn có (là cột chứa số liệu chính, như Mã ...) nếu ko sẽ lọc thiếu.


để tránh lỗi đó ---> bạn có thể Set vung = Sheets("Sheet1").Range("A4:C65000") '(hoặc C1048576 [nếu Excel 2007 trở về sau])

 

[KhoiSMC]

cám ơn bạn nhé. đúng là lỗi mình đang gặp phải.

Khoi

 

[KhoiSMC]

hi phucbugis,

Mình xin ý kiến tư vấn của bạn với về vấn đề liên quan đến .ClearContents như sau:

Mình đang tìm kiếm thủ tục nào trong VBA để có thể nhận biết được hành động nháy kép 2 lần tại ô B1 thì tiến hành lệnh xóa dữ liệu vùng B2:H2. Còn các vị trí khác nháy kép hoạt động bình thường.

Hiện nay mình mới biết dòng code sau có thể nháy kép vào bất kỳ vị trí nào trong sheet Data là xoá B2:H2.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
          Worksheets("Sheet1").Range("B2:H2").ClearContents
End Sub

Bạn xem file đính kèm nhé,

Thanks
Khoi

 

[phucbugis]

hi phucbugis,
Mình xin ý kiến tư vấn của bạn với về vấn đề liên quan đến .ClearContents như sau:
...
Thanks
Khoi

thông thường khi xoá số liệu thì nên hỏi người dùng trước khi run Macro, bạn tham khảo đoạn sau:
[GPECODE=vb]
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Answer, mSg

If Target.Address = "$B$1" Then
Cancel = True 'ko cho Edit
mSg = mSg & "ban co muon xoa' so lieu vung` B2:H2 tai. Sheet1"
Answer = MsgBox(mSg, vbYesNo + vbQuestion)
If Answer = vbNo Then Exit Sub
'If Answer = vbYes Then

Worksheets("Sheet1").Range("B2:H2").ClearContents
End If
End Sub
[/GPECODE]

 

[KhoiSMC]

cam on Phuc nhieu nhé.

khoi

 

[KhoiSMC]

hi, chuẩn không cần chỉnh.

Thanks bạn
Khoi