標題: EXCEL VBA的 篩選 小問題 [打印本頁]

---

作者: a1098131122    時間: 2020-12-9 16:55     標題: EXCEL VBA的 篩選 小問題

因為我希望EXCEL巨集可以把我要的項目篩選出來並且刪除，但是下面的黃色"製表日期: 109/12/09"每個檔案的日期都不一樣，想請教如果寫會讓EXCEL知道篩選出"製表日期"開頭的就可以了

Sub 巨集4()
'
' 巨集4 巨集
'

'
    Rows("1:3").Select
    Selection.Delete Shift:=xlUp
    Cells.Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$M$846").AutoFilter Field:=1, Criteria1:=Array( _
        "小計:", "合計:", "科目編號", "製表日期: 109/12/09"), Operator:=xlFilterValues
    ActiveCell.Offset(78, 0).Rows("1:1").EntireRow.Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    ActiveSheet.Range("$A$1:$M$824").AutoFilter Field:=1
    Columns("A:B").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Application.CutCopyMode = False
    Selection.FormulaR1C1 = "=R[-1]C"
    Columns("A:B").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Rows("2:2").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Columns("C:C").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Application.CutCopyMode = False
    Selection.FormulaR1C1 = "=R[-1]C"
    Columns("C:C").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveSheet.Range("$A$1:$M$846").AutoFilter Field:=4, Criteria1:="="
    ActiveCell.Offset(819, 0).Rows("1:1").EntireRow.Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=-3
    Selection.AutoFilter
    ActiveWindow.SmallScroll Down:=3
End Sub

---

作者: n7822123    時間: 2020-12-11 23:17

回復 1# a1098131122


試試看

ActiveSheet.Range("$A$1:$M$846").AutoFilter Field:=1, Criteria1:=Array( _
        "小計:", "合計:", "科目編號", "製表日期*"), Operator:=xlFilterValues   

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)