کد:
Private Sub Worksheet_Change(ByVal Target As Range)If Target.Address = "$C$8" Then
Dim wsSD As Worksheet
Dim wsS As Worksheet
On Error GoTo errHandler
Set wsSD = Sheets("Data")
Set wsS = Sheets("Excel Iran")
Application.EnableEvents = False
If Target.Value = "" Then
Call OrderSort("CriteriaName", True)
Else
Call OrderSort("CriteriaName", False)
End If
exitHandler:
Application.EnableEvents = True
Exit Sub
errHandler:
MsgBox "Could not filter orders"
Resume exitHandler
End If
End Sub
و حالا يك ماژول ميسازيم و اطلاعات زير رو توش كپي ميكنيم:
کد:
Sub OrderSort(strExt As String, isempty As Boolean)
Dim wsSD As Worksheet
Dim wsS As Worksheet
On Error GoTo errHandler
Set wsSD = Sheets("Data")
Set wsS = Sheets("Excel Iran")
If isempty Then
wsSD.Range("OrdersData").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=wsS.Range("ExtractOrders"), Unique:=True
Else
wsSD.Range("OrdersData").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=wsSD.Range(strExt), _
CopyToRange:=wsS.Range("ExtractOrders"), Unique:=True
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not filter orders"
Resume exitHandler
End Sub
بقيه اطلاعات از قبيل name manager و Data Validation رو بهتره از طريق فايل پيگيري كنيد.
فيلتر كردن از طريق ليست
پاسخ با نقل قول
علاقه مندی ها (Bookmarks)