[發問] 如何用VBA把每日報表匯成月報表並存檔 資料

ABK

下載 (97.81 KB)
日表

2016-6-13 17:31

下載 (105.54 KB)
月表

2016-6-13 17:36

水果進退貨紀錄.rar (8.18 KB)

水果進退貨紀錄
下載次數: 2

2016-6-13 17:37

請教如果我想將附檔中的"日表"中的紀錄 每日匯入到"月表" 中一列一列依序紀錄 並自動存檔，VBA要如何寫?

ABK

1. Sub 匯出至月表()
   
2. 
   
3.     Application.ScreenUpdating = False  '匯出資料時不換視窗 (開頭)
   
4. 
   
5.     Sheets("月表").Activate  '指定匯出的目標工作表
   
6. 
   
7. 
   
8. Dim i As String
   
9.    
   
10. 
    
11.    
    
12.    i = Sheets("月表").Range("A65536").End(xlUp).Row  '計算有資料最後一列之列數
    
13. 
    
14. 
    
15.       If Worksheets("月表").Cells(i, 1).Value >= Sheets("日表").Range("B1") Then MsgBox "早已存過資料！"   '比對日期-->日期相同 --> 早已存過資料(訊息) --> 確定--> 結束
    
16.       
    
17. 
    
18. 
    
19.       If Worksheets("月表").Cells(i, 1).Value < Sheets("日表").Range("B1") Then                           '比對日期--> 新日期 --> 進行資料匯出
    
20.   
    
21.            Sheets("月表").Cells(i + 1, 1).Value = Sheets("日表").Range("B1")                                      '日期匯出    -->"日表" B1 匯至 "月表" 最後一列 A
    
22.         
    
23.            Sheets("月表").Range(Cells(i + 1, 2), Cells(i + 1, 7)) = Sheets("日表").Range("B5:G5").Value           ' 第1區塊匯出-->"日表" B5:G5 匯至 "月表" 最後一列 B:G
    
24.         
    
25.            Sheets("月表").Range(Cells(i + 1, 14), Cells(i + 1, 19)) = Sheets("日表").Range("B6:G6").Value         ' 第2區塊匯出-->"日表" B6:G6 匯至 "月表" 最後一列 N:S
    
26.         
    
27.            Sheets("月表").Range(Cells(i + 1, 26), Cells(i + 1, 31)) = Sheets("日表").Range("B7:G7").Value         ' 第3區塊匯出-->"日表" B7:G7 匯至 "月表" 最後一列 Z:AE
    
28.          
    
29.            Sheets("月表").Range(Cells(i + 1, 8), Cells(i + 1, 13)) = Sheets("日表").Range("B11:G11").Value        ' 第4區塊匯出-->"日表" B11:G11 匯至 "月表" 最後一列 H:M
    
30.         
    
31.            Sheets("月表").Range(Cells(i + 1, 20), Cells(i + 1, 25)) = Sheets("日表").Range("B12:G12").Value       ' 第5區塊匯出-->"日表" B12:G12 匯至 "月表" 最後一列 T:Y
    
32.         
    
33.            Sheets("月表").Range(Cells(i + 1, 32), Cells(i + 1, 37)) = Sheets("日表").Range("B13:G13").Value       ' 第6區塊匯出-->"日表" B13:G13 匯至 "月表" 最後一列 AF:AK
    
34. 
    
35. ActiveWorkbook.Save  '存檔
    
36. 
    
37. 
    
38. MsgBox "資料匯出存檔完成！"    ' 匯出完成訊息
    
39. 
    
40. 
    
41.         End If
    
42.         
    
43.        'Application.ScreenUpdating = True  '匯出資料時不換視窗 (結尾) -->使用這個函式 螢幕  會閃一下 !
    
44.    Sheets("日表").Select                   '匯出資料時不換視窗 (結尾) -->改用這個函式 螢幕不會閃一下 !
    
45.    
    
46. End Sub

複製代碼

土法煉鋼，程式雖不精簡，功能到位了!