- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
本帖最後由 GBKEE 於 2017-12-27 14:55 編輯
回復 1# takeshilin88
試試看- Option Explicit
- Dim WB As Workbook, AR(), D As Object
- Sub Main()
- Ex_yymm
- Ex_Copy
- End Sub
- Private Sub Ex_yymm()
- Dim i As Integer, YM As String
- Set D = CreateObject("SCRIPTING.DICTIONARY") '字典物件
- With Workbooks("A.XLSM").Sheets("支票套印")
- i = 6
- Do
- YM = Format(.Cells(i, "D"), "ee/mm")
- D(YM) = "=AND(YEAR(到期日)=" & Format(.Cells(i, "D"), "YYYY") & ",MONTH(到期日)=" & Format(.Cells(i, "D"), "mm") & ")" 'Format(.Cells(i, "D"), "ee/mm") 'YM : 字典物件的key值 (讀取月份)
- i = i + 1
- Loop Until .Cells(i, "D") = ""
- i = Application.SheetsInNewWorkbook
- Application.SheetsInNewWorkbook = D.Count + 1
- Set WB = Workbooks.Add
- Application.SheetsInNewWorkbook = 1
- .Copy WB.Sheets(1)
- WB.Sheets(1).Rows("1:4").Delete
- WB.Sheets(1).Name = .Name
- End With
- AR = D.keys
- End Sub
- Private Sub Ex_Copy()
- Dim Sh As Worksheet, Rng As Range, i As Integer, xRow As Integer
- Set Sh = WB.Sheets(1)
- Set Rng = Sh.Cells(1, Columns.Count).Resize(2)
- Rng.Cells(1) = "AAA"
- For i = 0 To UBound(AR)
- Rng.Cells(2) = D(AR(i))
- Sh.Range("A:D").AdvancedFilter xlFilterCopy, Rng, WB.Sheets(i + 2).[A2]
- 'AdvancedFilter 進階篩選 , 篩選:複製 ,篩選準則, 複製到的地方
- With WB.Sheets(i + 2)
- .Name = Replace(AR(i), "/", "_") & " 到期"
- .[A1] = AR(i) & " 到期:"
- .[d1] = Application.Evaluate("sum(" & .[c:c].Address(, , , 1, 1) & ")")
- .[d1].NumberFormatLocal = "#,##0_ "
- xRow = WB.Sheets(WB.Sheets.Count).Cells(Rows.Count, "a").End(xlUp).Row
- If xRow > 1 Then xRow = xRow + 1
- .Range("a1").CurrentRegion.Copy WB.Sheets(WB.Sheets.Count).Cells(xRow, "A")
- End With
- Next
- Rng.Clear
- With WB
- .Sheets(WB.Sheets.Count).Name = "目前支票狀況"
- .SaveAs "D:\B.XLSX" '存檔
- End With
- End Sub
|
|
發表於 2017-12-10 16:50
| 