Board logo

標題: [發問] 資料範圍複製到不同檔案&依日期分別複製 [打印本頁]
作者: takeshilin88    時間: 2017-12-8 17:42     標題: 資料範圍複製到不同檔案&依日期分別複製

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

[attach]28100[/attach]
作者: GBKEE    時間: 2017-12-10 16:50

本帖最後由 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
複製代碼
作者: takeshilin88    時間: 2017-12-12 16:19

回復 2# GBKEE

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

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

更正：

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

回復 4# takeshilin88

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

請參考附檔，謝謝
作者: GBKEE    時間: 2017-12-14 14:49

回復 5# takeshilin88

每個工作表的 D1 ) ，想要有千分位樣式，例：1,234,567
你可用錄製巨集得到的程式碼套上
自行試試看
  1. .[d1] = Application.Evaluate("sum(" & .[c:c].Address(, , , 1, 1) & ")")
  2.             .[d1] =????
複製代碼
作者: takeshilin88    時間: 2017-12-15 15:46

回復 6# GBKEE

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

回復 7# takeshilin88
Selection 你可查看vba的說明看看
  1. .[d1] .NumberFormatLocal = "#,##0_ "   
複製代碼
作者: takeshilin88    時間: 2017-12-18 08:45

回復 8# GBKEE


    謝謝GBKEE大大，
    已經可以使用了，謝謝~~
    萬分感激......
作者: takeshilin88    時間: 2017-12-20 16:56

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

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

附檔
[attach]28151[/attach]
作者: takeshilin88    時間: 2017-12-22 15:43

本帖最後由 takeshilin88 於 2017-12-22 15:44 編輯

回復 10# takeshilin88


    GBKEE大大：
    再請教一下~~
    如果A檔的A1:D4不要複製到B檔，如下圖：
javascript:;

程式碼該如何修正呢？

謝謝~~~~
作者: takeshilin88    時間: 2017-12-25 17:18

GBKEE大大：
執行階段錯誤'1004':
應用程式或物件定義上的錯誤

出現的錯誤在第33列程式碼
        Rng.Cells(2) = D(AR(i))

謝謝~
作者: GBKEE    時間: 2017-12-26 14:52

回復 12# takeshilin88
執行這 Sub Main() 嗎!
  1. Sub Main()
  2.     Ex_yymm
  3.     Ex_Copy
  4. End Sub
複製代碼
作者: takeshilin88    時間: 2017-12-26 16:21

回復 13# GBKEE

是的，在執行Sub Main()的時候，
執行到Ex_Copy
到        Rng.Cells(2) = D(AR(i))
出現錯誤：
執行階段錯誤'1004':
應用程式或物件定義上的錯誤
作者: takeshilin88    時間: 2017-12-27 13:19

GBKEE大大：
附上檔案給您參考：
1.附檔執行時會出現
執行階段錯誤'1004':
應用程式或物件定義上的錯誤

出現的錯誤在第33列程式碼
        Rng.Cells(2) = D(AR(i))
2.另外要請教您：複製「支票套印」工作表，可以改成只複製「支票套印」中的A5開始到最後資料(目前為D14，會隨資料多寡變動)，只要複製資料範圍到B.XLS檔，程式碼應如何修改？
謝謝

javascript:;
作者: takeshilin88    時間: 2017-12-29 08:21

回復 15# takeshilin88


    謝謝GBKEE大大，會再花時間去詳細了解程式碼的，謝謝~~



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