EXCEL VBA．以〔公式〕檢測各欄符合條件，利用〔篩選〕匯出資料
＜．准提部林．＞
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
■主要需求：
絛件１：Ｊ欄含有 "T"
公式：=COUNTIF(J47,"*T*")
絛件２：Ｊ欄含有 "OK" (且) Ｐ欄〔日期〕為前七天以內
公式：=COUNTIF(J47,"*OK*")*IF(N(P47)=0,0,P47>=TODAY()-7)
任一條件成立，則納入篩選中，完整公式：
=COUNTIF(J47,"*T*")+COUNTIF(J47,"*OK*")*IF(N(P47)=0,0,P47>=TODAY()-7)
■解決方案：
增建Ｘ欄置入〔公式〕，並以此欄為篩選準則〔＞０〕
■程式碼：僅列主程式，其餘及註解請參閱範例檔
Sub 篩選_執行()
Dim i&, xName, xFile$
xName = Array("華川", "宏準")
Call 篩選_展開全表
With TmpSht
If .FilterMode Then .ShowAllData
.Rows("15:65536").Clear
End With
If DataCunt = 0 Then Exit Sub
Application.ScreenUpdating = False
FxClmn.Formula = _
"=COUNTIF(J47,""*T*"")+COUNTIF(J47,""*OK*"")*IF(N(P47)=0,0,P47>=TODAY()-7)"
uArea.AutoFilter Field:=24, Criteria1:=">0"
If Application.Subtotal(3, FxClmn) = 0 Then GoTo 101
Application.DisplayAlerts = False
For i = 0 To UBound(xName)
uArea.AutoFilter Field:=4, Criteria1:=xName(i)
If Application.Subtotal(3, FxClmn) > 0 Then
uBase.Copy TmpSht.[A15]
TmpSht.Copy
xFile = MyBook.Path & "\" & xName(i) & Format(Date, "yyyymmdd") & ".xls"
With ActiveWorkbook
.SaveAs xFile, CreateBackup:=False
.Close
End With
TmpSht.Rows("15:65536").Clear
End If
Next i
uArea.AutoFilter Field:=4
uBase.Copy TmpSht.[A15]
101: DataSht.ShowAllData
FxClmn.ClearContents
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
＜範例檔１＞：
＜範例檔２＞進階以〔廠商〕分別篩選匯出：
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
留言列表
