PJChen

　暱稱: PJ

帖子: 876
主題: 139
精華: 0
積分: 1041
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2022-5-23

論壇榮譽勳章論壇贊助勳章

1^# 跳轉到 » 正序看帖

打印

字體大小: tT

發表於 2019-11-5 19:02 | 只看該作者

[發問] 自動套表

Dear,
我不知道這個套表問題能否用函數解決,但因為表格中的資料大多用函數套出來的,所以在這裡發問...

自動套表.rar (34.84 KB)
出貨sheet是一個每天出貨用的表格,所以資料是變動的
因為檔案很大,我把與補貨明細無關的資料都Delete,避免干擾
每天的缺貨都需要這張報表去發給補貨的單位
除了表頭1:2外,這張報表每天初始都是空白的
我要把出貨sheet的資料套進來,請教用函數比較好做,還是VBA?

出貨sheet要套過來的貨料:
1.. 有缺貨的部份，依序從AS:BH帶資料
2.. 我先做一個2個範例"林口" & "暖暖1"
3.. 現在無法達成的部份在於
要如何讓有缺貨的AS:BH的表頭自動帶到這裡的B欄?但無缺貨的自動跳過！
並且讓缺貨的料號自動帶到A欄?
4.. 第2筆缺貨的表頭 "暖暖1"帶入B欄,料號自動帶到A欄後
如何讓E欄的公式以暖暖1為對象?而不用各別修改公式?
例： =SUMPRODUCT((出貨!$F$4:$F$12=$A7)*(出貨!$AS$3:$BH$3=B$6)*(出貨!$AS$4:$BH$12))
如何讓(出貨!$AS$3:$BH$3自動搜尋B$6),而不用各別改?

樓主熱帖

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2551
主題: 9
精華: 0
積分: 2607
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2022-5-5

31^#

發表於 2020-6-16 19:08 | 只看該作者

回復 30# PJChen

Sub 最後效期()
Dim Arr, Brr, Crr, R&, i&, j%, N&(1 To 2), NN&, BK As Workbook
'Set BK = Workbooks("最新庫存.xlsx")
'BK.Sheets("最後效期").Activate
R = [飛比!HE65536].End(xlUp).Row
Arr = Sheets("飛比").Range("F1:F" & R)
Brr = Sheets("飛比").Range("HD1:HE" & R)
ReDim Crr(1 To R, 1 To 2)
For i = 4 To R
For j = 1 To 2
If Val(Brr(i, j)) > 0 Then
N(j) = N(j) + 1: Crr(N(j), j) = Arr(i, 1)
If N(j) > NN Then NN = N(j)
End If
Next j
Next i
If NN = 0 Then Exit Sub
With Sheets("最後效期")
.[J4:K4].Resize(NN) = Crr
If NN <= 1 Then Exit Sub
.[L4:AB4].Copy .[L5:AB5].Resize(NN - 1)
.[A4:H4].Copy .[A5:H5].Resize(NN - 1)
End With
End Sub

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

帖子: 876
主題: 139
精華: 0
積分: 1041
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2022-5-23

論壇榮譽勳章論壇贊助勳章

30^#

發表於 2020-6-16 16:53 | 只看該作者

回復 29# 准提部林

准大,
1) 如圖,如何使J欄&K欄資料可以連續,且都從第4列開始載入資料?
2) 請問For i = 4 To R
該如何理解紅字部份?為何是4?

最新庫存A.rar (85.21 KB)

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2551
主題: 9
精華: 0
積分: 2607
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2022-5-5

29^#

發表於 2020-6-16 15:16 | 只看該作者

回復 28# PJChen

Sub 最後效期()
Dim Arr, Brr, Crr, R&, i&, N&, BK As Workbook
Set BK = Workbooks("最新庫存.xlsx")
BK.Sheets("最後效期").Activate
R = [飛比!HE65536].End(xlUp).Row
Arr = Sheets("飛比").Range("F1:F" & R)
Brr = Sheets("飛比").Range("HD1:HE" & R)
ReDim Crr(1 To R, 1 To 2)
For i = 4 To R
If Val(Brr(i, 1)) + Val(Brr(i, 2)) = 0 Then GoTo 101
N = N + 1
If Brr(i, 1) > 0 Then Crr(N, 1) = Arr(i, 1)
If Brr(i, 2) > 0 Then Crr(N, 2) = Arr(i, 1)
101: Next i
If N = 0 Then Exit Sub
With Sheets("最後效期")
.[J4:K4].Resize(N) = Crr
If N > 1 Then
.[L4:AB4].Copy .[L5:AB5].Resize(N - 1)
.[A4:H4].Copy .[A5:H5].Resize(N - 1)
End If
End With
End Sub

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

帖子: 876
主題: 139
精華: 0
積分: 1041
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2022-5-23

論壇榮譽勳章論壇贊助勳章

28^#

發表於 2020-6-16 12:43 | 只看該作者

本帖最後由 PJChen 於 2020-6-16 12:45 編輯

回復 27# 准提部林

最後效期,A4:H4,L4:AB4原來都有公式,作為動態表格使用,
程式只有做二個動作:
1) 將來源料號填入J:K欄,
2) 最後依據K欄的列數,將A4:H4,L4:AB4的公式下拉即可

最後效期.rar (82.19 KB)

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2551
主題: 9
精華: 0
積分: 2607
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2022-5-5

27^#

發表於 2020-6-16 11:23 | 只看該作者

回復 26# PJChen

你這程式碼根本拿不到任何資料!!!
應該是完全不了解原程式碼的意思, 這樣是無法套用的~~

光是這不成套的程式碼及簡單的說明, 無法了解詳細需求規則,
好像每次的提問, 我幾乎都抓不到要的是什麼???只能用猜,
這總不是辦法, 或許再研究一下提問方式, 讓別人都可了解清楚你的目的!!!

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

帖子: 876
主題: 139
精華: 0
積分: 1041
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2022-5-23

論壇榮譽勳章論壇贊助勳章

26^#

發表於 2020-6-16 00:15 | 只看該作者

回復 23# 准提部林

准大,
我修改了這個程式,想讓
HD欄>0,則填入,最後效期sheet的J欄
HE欄>0,則填入,最後效期sheet的K欄
目前只try了HE欄,但無法填入,可以幫我看看嗎?

最新庫存.rar (82.58 KB)

Sub 最後效期()
Dim Arr, Brr, R&, 統&, N&, BK As Workbook
Set BK = Workbooks("最新庫存.xlsx")
BK.Sheets("最後效期").Activate
Arr = Range([飛比!A1], [飛比!HE65536].End(xlUp))
For R = 4 To UBound(Arr)
統 = Val(Arr(R, UBound(Arr, 2)))
If 統 = 0 Then GoTo 101
N = N + 1
Arr(N, 11) = Arr(R, 5) '料號
101: Next R
If N = 0 Then Exit Sub
With [最後效期!A4:H4].Resize(N)
.Rows(1).Copy .Cells
End With
With [最後效期!L4:AB4].Resize(N)
.Rows(1).Copy .Cells
End With
End Sub

複製代碼

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

帖子: 876
主題: 139
精華: 0
積分: 1041
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2022-5-23

論壇榮譽勳章論壇贊助勳章

25^#

發表於 2020-4-17 23:00 | 只看該作者

回復 23# 准提部林

准大,
感謝你,我改好了

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

帖子: 876
主題: 139
精華: 0
積分: 1041
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2022-5-23

論壇榮譽勳章論壇贊助勳章

24^#

發表於 2020-4-17 22:18 | 只看該作者

回復 23# 准提部林

准大好,

不好意思,這個新表格是這幾天才啟用,發現格式沒做好,要更改如下
另外表格中取出的瓶數及箱數數值都不正確,我把正確答案列出,也請幫忙修正...再次感謝

最新庫存A_2.rar (178.15 KB)

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2551
主題: 9
精華: 0
積分: 2607
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2022-5-5

23^#

發表於 2020-4-17 09:39 | 只看該作者

回復 22# PJChen

Sub 廠缺匯總_匯入()
Dim Arr, R&, 廠缺數&, 入數&, N&
Call 廠缺匯總_清除
Arr = Range([飛比!A1], [飛比!BI65536].End(xlUp))
For R = 4 To UBound(Arr)
廠缺數 = Val(Arr(R, UBound(Arr, 2)))
入數 = Val(Arr(R, 7))
If 廠缺數 * 入數 = 0 Then GoTo 101
N = N + 1
Arr(N, 1) = Arr(R, 6)
Arr(N, 2) = Arr(R, 5)
Arr(N, 3) = Arr(R, 8)
Arr(N, 4) = 入數
Arr(N, 5) = 廠缺數 Mod 入數
Arr(N, 6) = Int(廠缺數 / 入數)
101: Next R
If N = 0 Then Exit Sub
With [廠缺匯總!A3:F3].Resize(N)
.Rows(1).Copy .Cells
.Value = Arr
End With
End Sub

Sub 廠缺匯總_清除()
With Sheets("廠缺匯總")
.UsedRange.Offset(3, 0).EntireRow.Delete
.[A3:F3].ClearContents
End With
End Sub

============================

TOP