[發問] 填入廠缺&註解

PJChen

大大好,
我想將 最新庫存B.xlsx的 廠缺 填入 月庫存表.xlsx中 並加以註解,請問以下需求該如何寫?
程式1
1) 月庫存表.xlsx的sheet以每月的天數命名
2) 將最新庫存B.xlsx的飛比sheet BJ4:CB資料
3) 填入月庫存表.xlsx中,對應 最新庫存B.xlsx H1的日期
例如：H1 為4/16,則對應月庫存表.xlsx的sheet 16
4) 最新庫存B.xlsx的飛比BJ4:CB儲存格<>"",則填入sheet 16 J4:Y
EX 1:月庫存表.xlsx sh16  J4值為1266
對應 最新庫存B.xlsx 的BJ4儲存格 值為34
則J4=1266-34

EX 2:月庫存表.xlsx sh16  L7值為198
對應 最新庫存B.xlsx 的BL7儲存格 值為""
則L7儲存格不改變....依此類推

程式2
程式1的廠缺資料填入後
將所有填入廠缺值的值存格,插入註解"廠缺XX"
EX 1:月庫存表.xlsx sh16  J4=1266-34
則註解為  廠缺34

填入廠缺.rar (842.49 KB)

下載次數: 7

2020-4-16 22:51

PJChen

Dear大大,
請指導 程式2
它可以增加空白註解,但無法將Workbooks("最新庫存B.xlsx").Sheets("飛比")的廠缺值載入註解中,
而且載入的註解無法依 Sheets("飛比")的廠缺值位置載入,註解填滿了 月庫存表.xlsx Range("J4:Y")
且希望註解的框框大小,可以依註解內容自動大小,目前的太大了.

1. Sub 廠缺註解()
   
2. Dim PH$, FN$, rng As Range, xb As Workbook, Sh As Worksheet, i As String
   
3. Application.ScreenUpdating = False
   
4. Application.DisplayAlerts = False       '一般提警示訊息關閉
   
5. Application.Calculation = xlManual     '手動計算
   
6. i = Format(Date, "D")
   
7. FN = "月庫存表.xlsx"  '目的檔
   
8. PH = "T:\0_自訂表單\其他表單\平日庫表\" '目的
   
9. On Error Resume Next: Set xb = Workbooks(FN): On Error GoTo 0 '檢查檔案是否已開啟(避免當機)
   
10. If xb Is Nothing Then Set xb = Workbooks.Open(PH & FN) '目的若未開啟,則開啟之
    
11. Set Sh = Workbooks("最新庫存B.xlsx").Sheets("飛比")
    
12. With Sh
    
13.     xRow = Cells(Cells.Rows.Count, "F").End(xlUp).Row
    
14.     Set sRng = Range("BJ4:BY" & xRow)  '來源:廠缺範圍
    
15. End With
    
16. 
    
17. With xb.Sheets(i)
    
18. xb.Sheets(i).Activate
    
19. xRow = Cells(Cells.Rows.Count, "E").End(xlUp).Row
    
20. For Each rng In Range("J4:Y" & xRow) '要寫入的範圍,目的訂單範圍
    
21. On Error Resume Next
    
22. If sRng <> "" Then  '儲存格的值不為 空白
    
23. Set cmt = rng.Addcomment  '將儲存格的值寫入註解中
    
24. cmt.Text "廠缺*" & sRng.Value
    
25. With rng.Comment.Shape.TextFrame.Characters.Font
    
26. .AutoSize = True
    
27. .Name = "細明體"
    
28. .Size = 10
    
29. End With
    
30. End If
    
31. Next rng
    
32. End With
    
33. Application.ScreenUpdating = True   '打開屏幕更新
    
34. End Sub

複製代碼

准提部林

考慮兩檔的[商品]及[銷售點]名稱或位置可能不一致, 所以寫得複雜,
有問題自行去修改:
填入廠缺v01.rar (163.8 KB)

下載次數: 11

2020-4-25 11:59

PJChen

回復 3# 准提部林

准大好,
填入"月庫存表"的廠缺值,必須用原來的值-廠缺
不能直接變成值,請問這個部份要怎麼改?
EX:
原訂單值為450
廠缺20
則相對應儲存格=450-20

PJChen

回復 3# 准提部林

& 第2個問題
因程式與平日檔案不放在一起的,所以我稍修改以下程式,但無法運作:
P.S. 原訂單值 對應儲存格 若無廠缺發生,則 保持現狀 (只有原訂單值)

1. Sub 廠缺註解()
   
2. Dim Sht As Worksheet, PH$, FN$, xB As Workbook, xS As Worksheet
   
3. Dim xD, xR As Range, Arr, R&, C&
   
4. Application.ScreenUpdating = False
   
5. Application.Calculation = xlManual
   
6. Set Sht = Sheets("飛比")
   
7. FN = "月庫存表.xls": PH = "T:\範例\"
   
8. On Error Resume Next: Set xB = Workbooks(FN): On Error GoTo 0
   
9. If xB Is Nothing Then Set xB = Workbooks.Open(PH & FN)
   
10. 'ThisWorkbook.Activate
    
11. xB.Activate
    
12. On Error Resume Next: Set xS = xB.Sheets(Day(Sht.[H1]) & ""): On Error GoTo 0
    
13. If xS Is Nothing Then MsgBox "〔日庫存表〕不存在! ": Exit Sub
    
14. If xS.[J2] = "***" Then MsgBox "本日庫存已扣除! ": Exit Sub

複製代碼

准提部林

回復 4# PJChen


1)  xR = "=" & Val(xR) & "-" & Arr(i, j)
    或 xR = "=" & IIf(Val(xR) = 0, "", xR) & "-" & Arr(i, j)

2)  FN = "月庫存表.xlsx"

PJChen

回復 6# 准提部林

准大,
我是用你回覆的檔案測試,檔案類型.xls, 因程式與平日檔案不放在一起的,所以我修改紅字部份,但無法運作,再麻煩指點！
Set Sht = Sheets("飛比")  '這裡卡住了,無法執行
FN = "月庫存表.xls": PH = "T:\範例\"
On Error Resume Next: Set xB = Workbooks(FN): On Error GoTo 0
If xB Is Nothing Then Set xB = Workbooks.Open(PH & FN)
'ThisWorkbook.Activate
xB.Activate  '這裡也有問題,無法執行

准提部林

回復 7# PJChen


Set Sht = ActiveSheet

PJChen

回復 8# 准提部林

准大,
還是不行,這樣會亂抓工作表,我把程式用我現行的做法放在Macro_1
麻煩幫忙看下...感謝

範例0426.rar (259.02 KB)

下載次數: 2

2020-4-26 19:52

PJChen

回復 8# 准提部林

准大,
我改好了,謝謝！