返回列表 上一主題 發帖

[發問] 資料範圍複製到不同檔案&依日期分別複製

[發問] 資料範圍複製到不同檔案&依日期分別複製

請問各位大大:
懇求幫忙~~~
我有兩個檔案:
A檔:負責做支票套印
B檔:支票本存檔&支票狀況
我在A檔工作表「支票套印」完成後,可以在A檔按下一個按鈕巨集後,可以執行以下動作:
1.先查詢B檔中「支票本」工作表裡有本月到期的支票(EX:現在是106年12月,就將106年12月的資料複製到「本月到期」工作表、次月到期的支票資料(107年1月),複製到「次月到期」工作表。
2.再到A檔中,「支票套印」工作表內新的支票資料複製到B檔的「支票本」最後資料的下一筆,EX:支票號碼A0004接A0005
3.將B檔「本月到期」工作表資料,複製到「目前支票狀況」工作表,A1位置
4.將B檔「次月到期」工作表資料,複製到「目前支票狀況」工作表,接著本月到期的資料下方貼上
請參考附檔,謝謝

支票.rar (15.72 KB)

本帖最後由 GBKEE 於 2017-12-27 14:55 編輯

回復 1# takeshilin88
試試看
  1. Option Explicit
  2. Dim WB As Workbook, AR(), D As Object
  3. Sub Main()
  4.     Ex_yymm
  5.     Ex_Copy
  6. End Sub
  7. Private Sub Ex_yymm()
  8.     Dim i As Integer, YM As String
  9.     Set D = CreateObject("SCRIPTING.DICTIONARY") '字典物件
  10.     With Workbooks("A.XLSM").Sheets("支票套印")
  11.         i = 6
  12.         Do
  13.             YM = Format(.Cells(i, "D"), "ee/mm")
  14.             D(YM) = "=AND(YEAR(到期日)=" & Format(.Cells(i, "D"), "YYYY") & ",MONTH(到期日)=" & Format(.Cells(i, "D"), "mm") & ")" 'Format(.Cells(i, "D"), "ee/mm")  'YM : 字典物件的key值 (讀取月份)
  15.             i = i + 1
  16.         Loop Until .Cells(i, "D") = ""
  17.         i = Application.SheetsInNewWorkbook
  18.         Application.SheetsInNewWorkbook = D.Count + 1
  19.         Set WB = Workbooks.Add
  20.         Application.SheetsInNewWorkbook = 1
  21.         .Copy WB.Sheets(1)
  22.         WB.Sheets(1).Rows("1:4").Delete
  23.         WB.Sheets(1).Name = .Name
  24.     End With
  25.     AR = D.keys
  26. End Sub
  27. Private Sub Ex_Copy()
  28.     Dim Sh As Worksheet, Rng As Range, i As Integer, xRow As Integer
  29.     Set Sh = WB.Sheets(1)
  30.     Set Rng = Sh.Cells(1, Columns.Count).Resize(2)
  31.     Rng.Cells(1) = "AAA"
  32.     For i = 0 To UBound(AR)
  33.         Rng.Cells(2) = D(AR(i))
  34.         Sh.Range("A:D").AdvancedFilter xlFilterCopy, Rng, WB.Sheets(i + 2).[A2]
  35.         'AdvancedFilter    進階篩選    , 篩選:複製 ,篩選準則,   複製到的地方
  36.         With WB.Sheets(i + 2)
  37.             .Name = Replace(AR(i), "/", "_") & " 到期"
  38.             .[A1] = AR(i) & " 到期:"
  39.             .[d1] = Application.Evaluate("sum(" & .[c:c].Address(, , , 1, 1) & ")")
  40.             .[d1].NumberFormatLocal = "#,##0_ "
  41.             xRow = WB.Sheets(WB.Sheets.Count).Cells(Rows.Count, "a").End(xlUp).Row
  42.             If xRow > 1 Then xRow = xRow + 1
  43.             .Range("a1").CurrentRegion.Copy WB.Sheets(WB.Sheets.Count).Cells(xRow, "A")
  44.         End With
  45.     Next
  46.     Rng.Clear
  47.     With WB
  48.         .Sheets(WB.Sheets.Count).Name = "目前支票狀況"
  49.         .SaveAs "D:\B.XLSX"    '存檔
  50.     End With
  51. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 2# GBKEE

GBKEE大大:
測試過後可以使用了,但是有兩項需要小小修改的地方:
1.每個月到期的加總金額儲存格 ( 每個工作表的 D1 ) ,想要有千分位樣式,例:1,234,567
2.如果在「到期日」D欄插入一欄「說明欄」:即「說明欄」成為D欄,「到期日」成為E欄,
    我將程式碼的D都改為E,會出現陣列索引超出範圍...
請幫幫忙教我如何調整程式碼,
謝謝

TOP

本帖最後由 takeshilin88 於 2017-12-12 17:28 編輯

更正:

GBKEE大大:
測試過後可以使用了,但是有兩項需要小小修改的地方:
1.每個月到期的加總金額儲存格 ( 每個工作表的 D1 ) ,想要有千分位樣式,例:1,234,567
2.如果在「到期日」D欄插入一欄「說明欄」:即「說明欄」成為D欄,「到期日」成為E欄,
    我將程式碼的D都改為E,會出現陣列索引超出範圍.......
   第2項已經解決了
請幫幫忙教我如何調整程式碼,
謝謝

TOP

回復 4# takeshilin88

幫忙設定:
    每個工作表的加總金額儲存格 ( 每個工作表的 D1 ) ,想要有千分位樣式,例:1,234,567

請參考附檔,謝謝

支票-加總欄數字格式.rar (25.42 KB)

TOP

回復 5# takeshilin88

每個工作表的 D1 ) ,想要有千分位樣式,例:1,234,567
你可用錄製巨集得到的程式碼套上
自行試試看
  1. .[d1] = Application.Evaluate("sum(" & .[c:c].Address(, , , 1, 1) & ")")
  2.             .[d1] =????
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 6# GBKEE

GBKEE大大:
    我在
    .[d1] = Application.Evaluate("sum(" & .[c:c].Address(, , , 1, 1) & ")")
    的下一行設定
    .[d1] = Selection.NumberFormatLocal = "#,##0_ "   
    結果每個工作表的d1儲存格都變成FALSE了,
    請問是哪裡出了問題呢?

TOP

回復 7# takeshilin88
Selection 你可查看vba的說明看看
  1. .[d1] .NumberFormatLocal = "#,##0_ "   
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 8# GBKEE


    謝謝GBKEE大大,
    已經可以使用了,謝謝~~
    萬分感激......

TOP

[版主管理留言]
  • GBKEE(2017/12/21 15:00): 2#的程式碼已更新

本帖最後由 takeshilin88 於 2017-12-20 17:00 編輯

求救~~
如果「到期日」的儲存格格式改成為中華民國曆,
則產生的B檔會抓不到到期日加總的資料,
好像是下面這個程式碼需要修改:
YM = Mid(.Cells(i, "D"), 1, InStrRev(.Cells(i, "D"), "/") - 1)
請各位大大幫幫忙~~

附檔
1061220-改日期格式.rar (27.22 KB)

TOP

        靜思自在 : 屋寬不如心寬。
返回列表 上一主題