[發問] VBA 填寫表格及另存新檔

lovenice831

附件是我在公司另一份常常要剪剪貼貼的報表，每次在data 頁填好了後，就要把資料copy 回report 頁的表格裡並另存新檔以便上傳，我找了很多例子，多數都用於一些相對值的表格，不知這種不規則的表格該怎麼寫,希望各位能幫幫忙，謝謝 test Receiving Data 2020.zip (37.25 KB)

下載次數: 16

2020-12-29 16:36

n7822123

回復 1# lovenice831

我也不知道你的表格要怎麼填寫......

發問要附上你想要的 "執行結果"

我先依我觀察的結果寫，你再看看

產生的報告會在檔案的同路徑下

如附件

test Receiving Data 2020-1230.rar (67.83 KB)

下載次數: 14

2020-12-30 09:58

lovenice831

回復 2# n7822123

先謝謝幫忙，但我下載不到附件

我先錄制給你們看看

lovenice831

附件是我在公司另一份常常要剪剪貼貼的報表，每次在data 頁填好了後，就要把資料copy 回report 頁的表格裡並 ...
lovenice831 發表於 2020-12-29 16:36

    嘗試錄製了一次，希望能幫忙改進，謝謝 test Receiving Data 2020_01.zip (52.1 KB)

下載次數: 13

2020-12-30 12:04

n7822123

回復 4# lovenice831

感覺跟我想的差不多吧!?~~ 你無法收附件?

我貼程式給你，你執行"收貨報表"即可~後面都是副程式

錄製的巨集 500多列，應該沒人看得下去.....=.=，你先試看看，有漏填再說

另外，如果你沒辦法下載我的附件，請把你的報告範本"稍微"修改一下

把列19、20、21 都改成資料列，列20別用粗體框線，

當資料多餘3列，我的程式會自動複製列20


Dim Arr
Sub 收貨報表()
Dim Brr(), R&, K%, LotNo$
Application.ScreenUpdating = False
Arr = ['Receiving DATA'!A4].CurrentRegion
For R = 2 To UBound(Arr)
    If Arr(R, 5) <> LotNo Then 新表 R: LotNo = Arr(R, 5): K = 0
    K = K + 1: ReDim Preserve Brr(1 To 11, 1 To K)
    Brr(1, K) = Arr(R, 9)     '貨物名稱
    Brr(3, K) = LotNo        '批號
    Brr(4, K) = Arr(R, 7)     '板號
    Brr(5, K) = Arr(R, 8)     '箱號
    Brr(8, K) = Arr(R, 10)   '實物收貨
    If R + 1 > UBound(Arr) Then 另存新檔 Brr: Exit For
    If Arr(R + 1, 5) <> LotNo Then 另存新檔 Brr
Next R: Erase Arr: Erase Brr
Sheets("Receiving DATA").Activate
End Sub

Sub 新表(ByVal R)
Sheets("Receiving Report").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Lot No. " & Arr(R, 5)
[C10] = Int(Arr(R, 2))        '收貨日期
[F10] = Arr(R, 2) - [C10]   '收貨時間
[C11] = Arr(R, 3)                '櫃號/貨車車牌
[J8] = Arr(R, 5)                    'Lot Number
[J10] = Arr(R, 11)                'PO No.
[J11] = Arr(R, 14)                'BD 負責人
End Sub

Sub 另存新檔(ByVal Brr)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
MyPath = ThisWorkbook.Path & "\"
Brr = Application.Transpose(Brr)
Rn = UBound(Brr): [G13] = Rn
If Rn >= 4 Then
  Rows("21:" & 21 + Rn - 4).Insert Shift:=4
  Rows(20).Copy
  Rows("21:" & 21 + Rn - 4).Select
  ActiveSheet.Paste
End If: [A10].Select
Application.CutCopyMode = False
[A19].Resize(Rn, 11) = Brr
[H13] = WorksheetFunction.Sum([E19].Resize(Rn))
ActiveSheet.Copy
With ActiveSheet
  .Parent.SaveAs MyPath & .Name & ".xls", xlNormal
  .Parent.Close 1
End With
ActiveSheet.Delete
End Sub

test Receiving Data 2020-1231.rar (49.93 KB)

下載次數: 10

2020-12-31 02:23

lovenice831

回復 5# n7822123


十分謝謝幫忙，我試試看

lovenice831

回復 5# n7822123


我試過了，謝謝你，
但我不是想要批次，因為data 內的資料是會增加，所以每次只會做另存更新的貨號報告上傳

n7822123

回復 7# lovenice831

但是你的資料內有不同的批號，只需要第一個批號出表格的意思?

還是各個批號加起來，出一個報表，但是右上角只填第一個批號?

還是只要抓Data表內的最後一個批次的資料出表格?

如果你Data內的資料量很多，每個批次都要出表格，VBA執行的確會花上不少時間

lovenice831

回復 8# n7822123


    DATA 的資料會增加而每增加一個我便需要在REPORT 表中填寫對的資料，再把REPORT 另存新檔上傳回公司系統，而REPORT 是用Reference No:來紀錄及命名，會否有語法可以在REPORT 頁中簡選 Reference No:，便能從DATE 中自動找出對應資顯示在REPORT 中? 我在網上找的多是用於同一分頁及表格都是單一對應的例子，這份表格的確是麻煩了些，先謝謝你的幫忙，謝謝

准提部林

Reference No: 如何填???

收貨報告表中有些checkbox,
在匯入資料後, 是否應先處理及勾選這些物件後再匯出另存???