- 帖子
- 2842
- 主題
- 10
- 精華
- 0
- 積分
- 2898
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2025-4-28
|
50#
發表於 2021-12-15 21:12
| 只看該作者
本帖最後由 准提部林 於 2021-12-15 21:14 編輯
沒詳細看要抓什麼數據, 隨便寫一個參考, 自行了解程式碼再根據需求改改:
Sub 盤點_期初庫存()
Dim Arr, DD, PH$, FN1$, FN2$, FT$
Dim xB1 As Workbook, xS1 As Worksheet, xB2 As Workbook, xS2 As Worksheet
Dim xF1 As Range, xF2 As Range, TT$, DY
Application.ScreenUpdating = False
PH = ThisWorkbook.Path & "\"
FN2 = Range("B8")
If FN2 = "" Then MsgBox "指定檔名稱未輸入! ": Exit Sub
FN2 = Dir(PH & FN2 & "*.xls*")
If FN2 = "" Then MsgBox "指定檔不存在! ": Exit Sub
'----------------------------------
FN1 = "多客戶盤點表.xls"
On Error Resume Next: Set xB1 = Workbooks(FN1): On Error GoTo 0
If xB1 Is Nothing Then Set xB1 = Workbooks.Open(PH & FN1)
'-----------------------------------
On Error Resume Next: Set xB2 = Workbooks(FN2): On Error GoTo 0
If xB2 Is Nothing Then Set xB2 = Workbooks.Open(PH & FN2)
FT = Split(FN2, "倉庫")(0) '截取[客戶]名稱
'-----------------------------------
ThisWorkbook.Activate
Set xS1 = xB1.Sheets("盤點")
DD = xS1.[e4]
Arr = Range(xS1.[di1], xS1.[a6536].End(3))
For i = 6 To UBound(Arr) Step 2
TT = Arr(i, 5) '品名
DY = Day(DD + Arr(i, UBound(Arr, 2)) - 1) '日期--day..以 di 欄取當天或前一天
If Arr(i, 1) <> FT Or TT = "" Then GoTo i01
On Error Resume Next: Set xS2 = xB2.Sheets(DY & ""): On Error GoTo 0
If xS2 Is Nothing Then GoTo i01
Set xF1 = xS2.Cells.Find("期末", Lookat:=xlWhole) '找[期末庫存]位置
Set xF2 = xS2.[b:b].Find(TT, Lookat:=xlWhole) '找B欄[品名]位置
If xF1 Is Nothing Or xF2 Is Nothing Then GoTo i01
xS1.Cells(i, 13) = xS2.Cells(xF2.Row, xF1.Column)
i01: Next i
MsgBox "期初庫存載入完成, 多客戶盤點表尚未儲存, 若確定無誤再手動存檔! "
End Sub |
|
發表於 2021-12-13 00:00
| 
