- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 7# s7659109
擴大資料庫的準則範圍為二欄- Option Explicit
- Sub Ex()
- Dim Rng(1 To 3) As Range
- Set Rng(1) = Range("B:D").SpecialCells(xlCellTypeConstants) '**資料庫
- Set Rng(2) = Cells(1, Columns.Count - 1).Resize(2, 2) '**資料庫的準則範圍,CriteriaRange
- Set Rng(3) = Range("G2,K2") '**資料庫的準則範圍,CopyToRange
- Rng(3)(1).CurrentRegion.Clear
- Rng(3).Areas(2).CurrentRegion.Clear
- '** 資料庫的準則為 "計算式準則",準則欄位名稱不可與 資料庫的欄位名稱相同 ****
-
- Rng(2).Cells(1, 1) = "TEST" '資料庫的準則欄位名稱
- Rng(2).Cells(2, 1) = "=VALUE(MID(ADD_M,1,1))<2" ''篩選資料庫的準則 , 計算式準則
- Rng(2).Cells(1, 2) = "ADD" '資料庫的準則欄位名稱
- Rng(2).Cells(2, 2) = "A001" ''篩選資料庫的準則
-
- '**MID(ADD_M,1,1) -> 資料庫欄位 "ADD_M" 的第一個字串"
- '**=VALUE(MID(ADD_M,1,1))<2 第一個字串小於2
- Rng(1).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Rng(2), CopyToRange:=Rng(3).Cells(1), Unique:=False
- Rng(3).Cells(0) = "小計"
- Rng(3).Cells(0, 3) = Application.Sum(Rng(3).Cells(0, 3).EntireColumn)
- Rng(2).Cells(2, 1) = "=VALUE(MID(ADD_M,1,1))>=2"
- '**=VALUE(MID(ADD_M,1,1))<2 第一個字串大於等於2
- Rng(1).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Rng(2), CopyToRange:=Rng(3).Areas(2), Unique:=False
- Rng(3).Areas(2).Cells(0) = "小計"
- Rng(3).Areas(2).Cells(0, 3) = Application.Sum(Rng(3).Areas(2).Cells(0, 3).EntireColumn)
- Rng(2).Clear
- End Sub
|
|
發表於 2016-10-19 12:26
| 