[發問] 累積報表 修正語法

Changbanana

請教各位先進~
目前有兩個SHEET
想要把每日的資料複製至 日累積報表
[每日資料]

下載 (29.36 KB)

2017-1-18 11:37

[日累積]

下載 (23.51 KB)

2017-1-18 11:37

由於目前是把每日資料逐行帶入日累積報表中
想請問要如何修正語法才能自動讀[每日資料]有幾行
複製到[日累積]有資料的下一行

小妹目前語法

1. Sub TEST()
   
2. Dim a, b, c, today
   
3. Dim i As String
   
4. 
   
5.    i = Sheets("日累積").Range("A65536").End(xlUp).Row  '計算有資料最後一列之列數
   
6.    j = Sheets("日檢核").Range("A65536").End(xlUp).Row
   
7.    '比對日期
   
8.       If Worksheets("日累積").Cells(i, 1).Value = Sheets("日檢核").Range("J2") Then MsgBox "早已存過資料！"
   
9.       
   
10.       If Worksheets("日累積").Cells(i, 1).Value <> Sheets("日檢核").Range("J2") Then
    
11.       
    
12.         For a = 1 To j - 1
    
13.      '日期匯出
    
14.             Sheets("日累積").Cells(i + a, 1).Value = Sheets("日檢核").Range("J2")
    
15.      '這裡是想要修正的地方 因日檢核資料有時多有時少 不能寫死
    
16.             Sheets("日累積").Range(Cells(i + 1, 2), Cells(i + 1, 8)) = Sheets("日檢核").Range("A2:G2").Value
    
17.             Sheets("日累積").Range(Cells(i + 2, 2), Cells(i + 2, 8)) = Sheets("日檢核").Range("A3:G3").Value
    
18.             Sheets("日累積").Range(Cells(i + 3, 2), Cells(i + 3, 8)) = Sheets("日檢核").Range("A4:G4").Value
    
19.             Sheets("日累積").Range(Cells(i + 4, 2), Cells(i + 4, 8)) = Sheets("日檢核").Range("A5:G5").Value
    
20.             
    
21. Next a
    
22. MsgBox "資料匯出完成！"    ' 匯出完成訊息
    
23. 
    
24. 
    
25.         End If
    
26. End Sub

複製代碼

麻煩了~
活頁簿0118.zip (386.27 KB)

下載次數: 12

2017-1-18 11:42

Changbanana

回復 2# justintoolbox

有成功執行喔~~
結果也是想要的
謝謝你^^

Changbanana

回復 4# jsc0518

試試~ 我稍稍結合了一下

1. Sub TEST()
   
2. Dim Rng, Dr
   
3. Dim i, j As String
   
4. Dim x As Integer
   
5. 
   
6.    i = Sheets("日累積").Range("A65536").End(xlUp).Row  '計算有資料最後一列之列數
   
7.    j = Sheets("日檢核").Range("A65536").End(xlUp).Row
   
8.      '比對日期
   
9.       If Worksheets("日累積").Cells(i, 1).Value = Sheets("日檢核").Range("J2") Then MsgBox "早已存過資料！"
   
10.       
    
11.       If Worksheets("日累積").Cells(i, 1).Value <> Sheets("日檢核").Range("J2") Then
    
12.       
    
13.         For a = 1 To j - 1
    
14.      '日期匯出
    
15.             Sheets("日累積").Cells(i + a, 1).Value = Sheets("日檢核").Range("J2")
    
16.         Next a
    
17.         
    
18.     With ThisWorkbook.Worksheets("日檢核")
    
19.         Rng = .[a1].CurrentRegion.Offset(1)
    
20.         ReDim Dr(UBound(Rng) - 1, 1)
    
21.         For x = 1 To UBound(Dr)
    
22.             Dr(x, 1) = .[J2]
    
23.         Next x
    
24.     End With
    
25.    
    
26.     With ThisWorkbook.Worksheets("日累積")
    
27.         .[A65535].End(xlUp).Offset(1).Resize(UBound(Dr), 1).Value = Dr
    
28.         .[B65535].End(xlUp).Offset(1).Resize(UBound(Rng), UBound(Rng, 2)).Value = Rng
    
29.     End With
    
30.    
    
31. MsgBox "資料匯出完成！"    ' 匯出完成訊息
    
32. 
    
33.         End If
    
34. End Sub

複製代碼