返回列表 上一主題 發帖

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

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

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

本帖最後由 n7822123 於 2020-12-30 09:58 編輯

回復 1# lovenice831

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

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

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

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

如附件


test Receiving Data 2020-1230.rar (67.83 KB)
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

本帖最後由 lovenice831 於 2020-12-30 10:01 編輯

回復 2# n7822123

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

我先錄制給你們看看

TOP

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



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

TOP

本帖最後由 n7822123 於 2020-12-31 02:32 編輯

回復 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)
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

回復 5# n7822123


十分謝謝幫忙,我試試看

TOP

回復 5# n7822123


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

TOP

本帖最後由 n7822123 於 2020-12-31 18:09 編輯

回復 7# lovenice831

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

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

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

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

程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

回復 8# n7822123


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

TOP

Reference No: 如何填???

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

TOP

        靜思自在 : 有心就有福,有願就有力,自造福田,自得福緣。
返回列表 上一主題