- 帖子
- 913
- 主題
- 150
- 精華
- 0
- 積分
- 1089
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- office 2019
- 閱讀權限
- 50
- 性別
- 女
- 註冊時間
- 2011-8-28
- 最後登錄
- 2023-7-19
 
|
15#
發表於 2020-5-3 15:02
| 只看該作者
回復 14# 准提部林
准大,
每月會變動的檔名,指定儲存格作用不大,我還是想用*月庫存表*的開啟方式,
略修改程式,可以開啟檔案,但無法載入廠缺,可否幫忙看下問題所在?- Sub 載入廠缺註解()
- Dim Sht As Worksheet, PH$, FN$, xB As Workbook, xS As Worksheet
- Dim xD, xR As Range, Arr, R&, C&
- Application.ScreenUpdating = False
- Application.Calculation = xlManual
- Set Sht = Workbooks("最新庫存B.xlsx").Sheets("飛比") '來源
- PH = "T:\範例\"
- FN = Dir(PH & "*月庫存表*.xlsx")
- Do While FN <> ""
- On Error Resume Next: Set xB = Workbooks(FN): On Error GoTo 0
- If xB Is Nothing Then Set xB = Workbooks.Open(PH & FN) '公用庫存表
- FN = Dir
- Loop
- xB.Activate '公用庫存表
- On Error Resume Next: Set xS = xB.Sheets(Day(Sht.[H1]) & ""): On Error GoTo 0 '比對日期
- If xS Is Nothing Then MsgBox "〔日庫存表〕不存在! ": Exit Sub
- If xS.[J2] = "***" Then MsgBox "本日庫存已扣除! ": Exit Sub
- '-------------------------------------
- Set xD = CreateObject("Scripting.Dictionary") '記錄[來源]欄位置
- For Each xR In Range(xS.[E4], xS.[E65536].End(xlUp)) '公用庫存表
- If xR <> "" Then xD(xR & "") = xR.Row
- Next
- For Each xR In xS.[J3:AZ3] '記錄公用庫存表[商品名稱]列位置
- If xR = "" Or xR = "合計" Then Exit For
- xD(xR & "") = xR.Column
- Next
- '-------------------------------------
- R = Sht.[H65536].End(xlUp).Row '以來源[商品名稱]為資料列數
- Arr = Sht.Range("BJ4:CB" & R) '來源廠缺範圍
- For i = 1 To UBound(Arr)
- R = xD(Sht.[H4].Cells(i, 1) & "") '取得來源[商品名稱]列位置
- If R = 0 Then GoTo i01
- For j = 1 To UBound(Arr, 2)
- C = xD(Sht.[BJ3].Cells(1, j) & "") '取得[來源]欄位置
- If C = 0 Then GoTo j01
- If Val(Arr(i, j)) = 0 Then GoTo j01
- Set xR = xS.Cells(R, C)
- ' xR = Val(xR) - Arr(i, j) '載入廠缺,變成值
- xR = "=" & Val(xR) & "-" & Arr(i, j) '載入廠缺
- xR.NoteText "PJ:" & Chr(10) & "廠缺*" & Arr(i, j) '註解的內容,Chr(10)換行
- With xR.Comment.Shape '註解的框大小
- .Top = xR.Top
- .Left = xR.Cells(1, 2).Left + 1
- .Height = xR.Height + 12
- .Width = 50
- ' .TextFrame.Characters.Font.Size = 9 '自訂字體大小,在家可以運作,但公司不行
- '.Shadow.Visible = False '取消陰影
- End With
- j01: Next j
- i01: Next i
- xS.[J2] = "***" '扣除庫存以3星註記(避免重覆扣除)
- Application.Calculation = xlCalculationAutomatic
- Application.GoTo xS.[J3] '公用庫存表起始列位置
- End Sub
|
|
發表於 2020-5-3 09:43
| 
