Thử code này đi. Thiếu gì cách xử.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [G2:H2]) Is Nothing Then
Application.EnableEvents = False
Dim tam
If Target.Column = 7 Then
tam = Target
Target.FormulaR1C1 = "=""=" & "" & "" & tam & """"
End If
[A4:E10000].AdvancedFilter 2, [G1:H2], [G4:J4]
If Target.Column = 7 Then Target = tam
Application.EnableEvents = True
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
Set Rng = Sheet1.[a5].CurrentRegion
If Not Intersect(Target, Sheet2.[C2].Resize(, 3)) Is Nothing Then
Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheet2.Range( _
"D1:F2"), CopyToRange:=Sheet2.Range("A4:d4"), unique:=False
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [c2].Resize(, 3)) Is Nothing Then
On Error GoTo 111
Application.EnableEvents = False
Dim tg: tg = [c2].Value
[c2].Value = "'=" & tg
Sheet1.[a5].CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("C1:E2"), _
CopyToRange:=Range("A4:D4"), unique:=False
[c2].Value = tg
111: Application.EnableEvents = True
End If
End SubPrivate Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [c2].Resize(, 3)) Is Nothing Then
On Error GoTo 111
Application.EnableEvents = False
Dim tg: tg = [c2].Value
[c2].Value = "'=" & tg
Sheet1.[a5].CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("C1:E2"), _
CopyToRange:=Range("A4:D4"), unique:=False
[c2].Value = tg
111: Application.EnableEvents = True
End If
End SubOption Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [a2:c2]) Is Nothing Then
On Error GoTo 111
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim tg, d, j As Long
d = Array("'>=", "'<=", "'=")
tg = [a2:c2].Value
For j = 1 To 3
d(j - 1) = d(j - 1) & tg(1, j)
Next j
[a2:c2].Value = d
Range("A5:D65000").ClearContents
Sheet1.[a5].CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("A1:C2"), _
CopyToRange:=Range("A4:D4"), unique:=False
[a2:c2].Value = tg
111: Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub
