Board logo

標題: [發問] 累積報表 修正語法 [打印本頁]
作者: Changbanana    時間: 2017-1-18 11:42     標題: 累積報表 修正語法

請教各位先進~
目前有兩個SHEET
想要把每日的資料複製至 日累積報表
[每日資料]
[attach]26412[/attach]
[日累積]
[attach]26413[/attach]
由於目前是把每日資料逐行帶入日累積報表中
想請問要如何修正語法才能自動讀[每日資料]有幾行
複製到[日累積]有資料的下一行

小妹目前語法
  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
複製代碼
麻煩了~
[attach]26414[/attach]
作者: justintoolbox    時間: 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
複製代碼
作者: Changbanana    時間: 2017-2-2 16:51

回復 2# justintoolbox

有成功執行喔~~
結果也是想要的
謝謝你^^
作者: jsc0518    時間: 2017-2-7 20:23

本帖最後由 jsc0518 於 2017-2-7 20:25 編輯

回復 2# justintoolbox

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

[attach]26547[/attach]

[attach]26548[/attach]

[attach]26550[/attach]
作者: Changbanana    時間: 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
複製代碼
作者: jsc0518    時間: 2017-2-23 19:36

回復 5# Changbanana


感謝您的指導，測試成功



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