返回列表 上一主題 發帖

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

Changbanana

帖子
76 
主題
17 
精華
0 
積分
95 
點名
0  
作業系統
windowsxp 
軟體版本
office2007 
閱讀權限
20 
性別
女 
註冊時間
2016-8-19 
最後登錄
2021-5-5 

論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2017-1-18 11:42 | 只看該作者

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

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

[日累積]

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

小妹目前語法
  1. Sub TEST()
  2. Dim a, b, c, today
  3. Dim i As String

  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 "資料匯出完成！"    ' 匯出完成訊息


  25.         End If
  26. End Sub
複製代碼
麻煩了~
活頁簿0118.zip (386.27 KB)
收藏 分享

justintoolbox

帖子
57 
主題
14 
精華
0 
積分
73 
點名
0  
作業系統
win8.1 
軟體版本
office2010 
閱讀權限
20 
註冊時間
2015-4-2 
最後登錄
2019-6-17 
2#
發表於 2017-1-24 20:15 | 只看該作者
請教各位先進~
目前有兩個SHEET
想要把每日的資料複製至 日累積報表
[每日資料]

[日累積]

由於目前 ...
Changbanana 發表於 2017-1-18 11:42



試試看,看看能否幫得上忙.:)
  1. Sub EX()
  2. Dim Rng, Dr
  3. Dim i As Integer
  4. Dim a

  6. With ThisWorkbook.Worksheets("日檢核")
  7.    Rng = .[a1].CurrentRegion.Offset(1)
  8.    ReDim Dr(UBound(Rng) - 1, 1)
  9.    For i = 1 To UBound(Dr)
  10.         Dr(i, 1) = .[J2]
  11.    Next i
  12.    a = MsgBox("需要刪除當日檢核?", vbInformation + vbYesNo, "詢問")
  13.     If a = vbYes Then
  14.         .[a1].CurrentRegion.Offset(1).ClearContents
  15.     End If
  16. End With
  17. With ThisWorkbook.Worksheets("日累積")
  18.     .[A65535].End(xlUp).Offset(1).Resize(UBound(Dr), 1).Value = Dr
  19.     .[B65535].End(xlUp).Offset(1).Resize(UBound(Rng), UBound(Rng, 2)).Value = Rng
  20. End With

  22. End Sub
複製代碼

TOP

Changbanana

帖子
76 
主題
17 
精華
0 
積分
95 
點名
0  
作業系統
windowsxp 
軟體版本
office2007 
閱讀權限
20 
性別
女 
註冊時間
2016-8-19 
最後登錄
2021-5-5 

論壇贊助勳章
3#
發表於 2017-2-2 16:51 | 只看該作者
回復 2# justintoolbox

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

TOP

jsc0518

帖子
455 
主題
111 
精華
0 
積分
563 
點名
221  
作業系統
Windows 10 
軟體版本
Office 2019 
閱讀權限
50 
性別
男 
註冊時間
2013-11-7 
最後登錄
2024-11-5 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章論壇贊助勳章
4#
發表於 2017-2-7 20:23 | 只看該作者
本帖最後由 jsc0518 於 2017-2-7 20:25 編輯

回復 2# justintoolbox

請教一下，若要將工作表"日檢核"內的日期自動也把帶入到工作表"日累積" A欄下
要如何做?





123.rar (352.46 KB)

123.rar (352.46 KB)

FILE

Just do it.

TOP

Changbanana

帖子
76 
主題
17 
精華
0 
積分
95 
點名
0  
作業系統
windowsxp 
軟體版本
office2007 
閱讀權限
20 
性別
女 
註冊時間
2016-8-19 
最後登錄
2021-5-5 

論壇贊助勳章
5#
發表於 2017-2-23 11:49 | 只看該作者
回復 4# jsc0518

試試~ 我稍稍結合了一下
  1. Sub TEST()
  2. Dim Rng, Dr
  3. Dim i, j As String
  4. Dim x As Integer

  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 "資料匯出完成！"    ' 匯出完成訊息

  33.         End If
  34. End Sub
複製代碼

TOP

jsc0518

帖子
455 
主題
111 
精華
0 
積分
563 
點名
221  
作業系統
Windows 10 
軟體版本
Office 2019 
閱讀權限
50 
性別
男 
註冊時間
2013-11-7 
最後登錄
2024-11-5 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章論壇贊助勳章
6#
發表於 2017-2-23 19:36 | 只看該作者
回復 5# Changbanana


感謝您的指導，測試成功
Just do it.

TOP

        靜思自在 : 滴水成河。粒米成蘿，勿輕己靈，勿以善小而不為。
返回列表 上一主題