Initial commit: PMC物控优化方案 A+B+C (2026-04-07)
This commit is contained in:
commit
5ec5e27cae
675
PMC_缺料交期优化.bas
Normal file
675
PMC_缺料交期优化.bas
Normal file
@ -0,0 +1,675 @@
|
|||||||
|
' ============================================================================
|
||||||
|
' PMC 物控优化方案 - 缺料交期总表 + 数据链路打通 + 字段补全
|
||||||
|
' 来源：全機型_日報表.xlsm 优化
|
||||||
|
' 创建日期：2026-04-07
|
||||||
|
' 适用场景：PMC 物控查缺料、看交期
|
||||||
|
' ============================================================================
|
||||||
|
|
||||||
|
Option Explicit
|
||||||
|
|
||||||
|
' ============================================================================
|
||||||
|
' 方案 C：新建缺料交期总表
|
||||||
|
' ============================================================================
|
||||||
|
|
||||||
|
Sub CreateShortageDeliveryReport()
|
||||||
|
' 新建「缺料交期总表」，汇总所有关键信息
|
||||||
|
' 自动从 缺料 / qs / TMH / 0000 / KCB 表提取数据
|
||||||
|
|
||||||
|
Dim wsSource As Worksheet
|
||||||
|
Dim wsDest As Worksheet
|
||||||
|
Dim wsQS As Worksheet
|
||||||
|
Dim wsTMH As Worksheet
|
||||||
|
Dim ws0000 As Worksheet
|
||||||
|
Dim wsKCB As Worksheet
|
||||||
|
Dim dictQS As Object ' qs 数据字典 (料号 → 确认交期/数量)
|
||||||
|
Dim dictTMH As Object ' TMH 数据字典 (料号 → 待提数量)
|
||||||
|
Dim dictATP As Object ' 0000 数据字典 (料号 → L/T内缺料/接单欠料)
|
||||||
|
Dim dictStock As Object ' KCB 数据字典 (料号 → 库存)
|
||||||
|
|
||||||
|
Dim lastRow As Long, lastRowQS As Long, lastRowTMH As Long
|
||||||
|
Dim lastRow0000 As Long, lastRowKCB As Long
|
||||||
|
Dim i As Long, destRow As Long
|
||||||
|
Dim cpn As String
|
||||||
|
Dim shortageQty As Double
|
||||||
|
Dim priority As String
|
||||||
|
Dim confirmedDate As String
|
||||||
|
Dim confirmedQty As Double
|
||||||
|
Dim tmhQty As Double
|
||||||
|
Dim ltShortage As Double
|
||||||
|
Dim poQty As Double
|
||||||
|
Dim stockQty As Double
|
||||||
|
Dim modelName As String
|
||||||
|
Dim vendor As String
|
||||||
|
Dim key As Variant
|
||||||
|
|
||||||
|
' ---- 性能优化 ----
|
||||||
|
OptimizeVBA True
|
||||||
|
On Error GoTo ErrorHandler
|
||||||
|
|
||||||
|
' ---- 检查必要工作表 ----
|
||||||
|
If Not WorksheetExists("缺料") Then
|
||||||
|
MsgBox "「缺料」工作表不存在！", vbExclamation
|
||||||
|
GoTo CleanUp
|
||||||
|
End If
|
||||||
|
Set wsSource = ThisWorkbook.Worksheets("缺料")
|
||||||
|
|
||||||
|
' ---- 建立字典：从 qs 获取确认交期 ----
|
||||||
|
Set dictQS = CreateObject("Scripting.Dictionary")
|
||||||
|
If WorksheetExists("qs") Then
|
||||||
|
Set wsQS = ThisWorkbook.Worksheets("qs")
|
||||||
|
lastRowQS = wsQS.Cells(wsQS.Rows.Count, "E").End(xlUp).Row
|
||||||
|
|
||||||
|
For i = 2 To lastRowQS
|
||||||
|
cpn = Trim(CStr(wsQS.Cells(i, 5).Value)) ' E列 = 茂瑞料号
|
||||||
|
If cpn <> "" Then
|
||||||
|
' J列 = 厂商回复交期(ETD)
|
||||||
|
' K列 = 厂商回复数量
|
||||||
|
confirmedDate = Trim(CStr(wsQS.Cells(i, 10).Value))
|
||||||
|
confirmedQty = Val(CStr(wsQS.Cells(i, 11).Value))
|
||||||
|
|
||||||
|
If Not dictQS.exists(cpn) Then
|
||||||
|
dictQS.Add cpn, CreateObject("Scripting.Dictionary")
|
||||||
|
End If
|
||||||
|
dictQS(cpn).Add "ETD", confirmedDate
|
||||||
|
dictQS(cpn).Add "Qty", confirmedQty
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
End If
|
||||||
|
|
||||||
|
' ---- 建立字典：从 TMH 获取待提数量 ----
|
||||||
|
Set dictTMH = CreateObject("Scripting.Dictionary")
|
||||||
|
If WorksheetExists("TMH") Then
|
||||||
|
Set wsTMH = ThisWorkbook.Worksheets("TMH")
|
||||||
|
lastRowTMH = wsTMH.Cells(wsTMH.Rows.Count, "E").End(xlUp).Row
|
||||||
|
|
||||||
|
For i = 2 To lastRowTMH
|
||||||
|
cpn = Trim(CStr(wsTMH.Cells(i, 5).Value)) ' E列 = 料号
|
||||||
|
If cpn <> "" Then
|
||||||
|
tmhQty = Val(CStr(wsTMH.Cells(i, 6).Value)) ' F列 = 数量
|
||||||
|
If dictTMH.exists(cpn) Then
|
||||||
|
dictTMH(cpn) = dictTMH(cpn) + tmhQty
|
||||||
|
Else
|
||||||
|
dictTMH.Add cpn, tmhQty
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
End If
|
||||||
|
|
||||||
|
' ---- 建立字典：从 0000 获取 ATP 分析 ----
|
||||||
|
Set dictATP = CreateObject("Scripting.Dictionary")
|
||||||
|
If WorksheetExists("0000") Then
|
||||||
|
Set ws0000 = ThisWorkbook.Worksheets("0000")
|
||||||
|
lastRow0000 = ws0000.Cells(ws0000.Rows.Count, "A").End(xlUp).Row
|
||||||
|
|
||||||
|
For i = 3 To lastRow0000 ' 数据从第3行开始
|
||||||
|
cpn = Trim(CStr(ws0000.Cells(i, 1).Value)) ' A列 = P/N
|
||||||
|
If cpn <> "" Then
|
||||||
|
' Q列 = L/T内缺料, R列 = 接单欠料, N列 = PO
|
||||||
|
ltShortage = Val(CStr(ws0000.Cells(i, 17).Value))
|
||||||
|
poQty = Val(CStr(ws0000.Cells(i, 14).Value))
|
||||||
|
|
||||||
|
dictATP.Add cpn, CreateObject("Scripting.Dictionary")
|
||||||
|
dictATP(cpn).Add "LT", ltShortage
|
||||||
|
dictATP(cpn).Add "PO", poQty
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
End If
|
||||||
|
|
||||||
|
' ---- 建立字典：从 KCB 获取库存 ----
|
||||||
|
Set dictStock = CreateObject("Scripting.Dictionary")
|
||||||
|
If WorksheetExists("KCB") Then
|
||||||
|
Set wsKCB = ThisWorkbook.Worksheets("KCB")
|
||||||
|
lastRowKCB = wsKCB.Cells(wsKCB.Rows.Count, "B").End(xlUp).Row
|
||||||
|
|
||||||
|
For i = 3 To lastRowKCB ' 数据从第3行开始
|
||||||
|
cpn = Trim(CStr(wsKCB.Cells(i, 2).Value)) ' B列 = Material
|
||||||
|
If cpn <> "" Then
|
||||||
|
stockQty = Val(CStr(wsKCB.Cells(i, 3).Value)) ' C列 = UnrestrictedUseQty
|
||||||
|
dictStock.Add cpn, stockQty
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
End If
|
||||||
|
|
||||||
|
' ---- 删除旧的工作表 ----
|
||||||
|
Application.DisplayAlerts = False
|
||||||
|
On Error Resume Next
|
||||||
|
ThisWorkbook.Worksheets("缺料交期总表").Delete
|
||||||
|
Application.DisplayAlerts = True
|
||||||
|
On Error GoTo ErrorHandler
|
||||||
|
|
||||||
|
' ---- 新建目标工作表 ----
|
||||||
|
Set wsDest = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
|
||||||
|
wsDest.Name = "缺料交期总表"
|
||||||
|
|
||||||
|
' ---- 写入表头 ----
|
||||||
|
Dim headers As Variant
|
||||||
|
headers = Array("序号", "料号", "机种", "IC用途", "IC厂商", _
|
||||||
|
"结余/欠料", "PO", "TMH待提", "库存", _
|
||||||
|
"L/T内缺料", "接单欠料", _
|
||||||
|
"确认交期", "预计到货数量", _
|
||||||
|
"优先级", "跟催建议", "备注")
|
||||||
|
|
||||||
|
Dim col As Long
|
||||||
|
For col = 0 To UBound(headers)
|
||||||
|
wsDest.Cells(1, col + 1).Value = headers(col)
|
||||||
|
wsDest.Cells(1, col + 1).Font.Bold = True
|
||||||
|
wsDest.Cells(1, col + 1).Interior.Color = RGB(0, 112, 192)
|
||||||
|
wsDest.Cells(1, col + 1).Font.Color = RGB(255, 255, 255)
|
||||||
|
Next col
|
||||||
|
|
||||||
|
' ---- 读取缺料表数据 ----
|
||||||
|
lastRow = wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row
|
||||||
|
destRow = 2
|
||||||
|
|
||||||
|
For i = 4 To lastRow ' 数据从第4行开始（第3行是表头）
|
||||||
|
cpn = Trim(CStr(wsSource.Cells(i, 2).Value)) ' B列 = CPN
|
||||||
|
If cpn = "" Or cpn = "0" Then GoTo NextRow
|
||||||
|
|
||||||
|
' 基础字段
|
||||||
|
wsDest.Cells(destRow, 1).Value = wsSource.Cells(i, 1).Value ' 序号
|
||||||
|
wsDest.Cells(destRow, 2).Value = cpn ' 料号
|
||||||
|
wsDest.Cells(destRow, 3).Value = wsSource.Cells(i, 3).Value ' 机种
|
||||||
|
wsDest.Cells(destRow, 4).Value = wsSource.Cells(i, 4).Value ' IC用途
|
||||||
|
wsDest.Cells(destRow, 5).Value = wsSource.Cells(i, 5).Value ' IC厂商
|
||||||
|
wsDest.Cells(destRow, 6).Value = wsSource.Cells(i, 7).Value ' 结余/欠料
|
||||||
|
wsDest.Cells(destRow, 7).Value = wsSource.Cells(i, 10).Value ' PO
|
||||||
|
|
||||||
|
' TMH 待提
|
||||||
|
If dictTMH.exists(cpn) Then
|
||||||
|
wsDest.Cells(destRow, 8).Value = dictTMH(cpn)
|
||||||
|
Else
|
||||||
|
wsDest.Cells(destRow, 8).Value = 0
|
||||||
|
End If
|
||||||
|
|
||||||
|
' 库存
|
||||||
|
If dictStock.exists(cpn) Then
|
||||||
|
wsDest.Cells(destRow, 9).Value = dictStock(cpn)
|
||||||
|
Else
|
||||||
|
wsDest.Cells(destRow, 9).Value = 0
|
||||||
|
End If
|
||||||
|
|
||||||
|
' ATP 数据
|
||||||
|
If dictATP.exists(cpn) Then
|
||||||
|
wsDest.Cells(destRow, 10).Value = dictATP(cpn)("LT") ' L/T内缺料
|
||||||
|
wsDest.Cells(destRow, 11).Value = dictATP(cpn)("PO") ' 接单欠料
|
||||||
|
Else
|
||||||
|
wsDest.Cells(destRow, 10).Value = ""
|
||||||
|
wsDest.Cells(destRow, 11).Value = ""
|
||||||
|
End If
|
||||||
|
|
||||||
|
' qs 确认交期
|
||||||
|
If dictQS.exists(cpn) Then
|
||||||
|
wsDest.Cells(destRow, 12).Value = dictQS(cpn)("ETD") ' 确认交期
|
||||||
|
wsDest.Cells(destRow, 13).Value = dictQS(cpn)("Qty") ' 预计到货数量
|
||||||
|
Else
|
||||||
|
wsDest.Cells(destRow, 12).Value = "待确认"
|
||||||
|
wsDest.Cells(destRow, 13).Value = 0
|
||||||
|
End If
|
||||||
|
|
||||||
|
' ---- 计算优先级 ----
|
||||||
|
shortageQty = Val(CStr(wsSource.Cells(i, 7).Value)) ' G列 = 结余/欠料
|
||||||
|
poQty = Val(CStr(wsSource.Cells(i, 10).Value)) ' J列 = PO
|
||||||
|
|
||||||
|
If shortageQty < 0 And poQty = 0 Then
|
||||||
|
priority = "高"
|
||||||
|
wsDest.Cells(destRow, 15).Value = "高"
|
||||||
|
wsDest.Cells(destRow, 15).Interior.Color = RGB(255, 0, 0)
|
||||||
|
wsDest.Cells(destRow, 15).Font.Color = RGB(255, 255, 255)
|
||||||
|
wsDest.Cells(destRow, 16).Value = "紧急跟催：结余为负且无PO，立即联系采购"
|
||||||
|
ElseIf shortageQty < 0 And poQty > 0 Then
|
||||||
|
priority = "中"
|
||||||
|
wsDest.Cells(destRow, 15).Value = "中"
|
||||||
|
wsDest.Cells(destRow, 15).Interior.Color = RGB(255, 192, 0)
|
||||||
|
wsDest.Cells(destRow, 16).Value = "跟催交期：确认PO交期，追踪厂商回复"
|
||||||
|
ElseIf shortageQty >= 0 And dictStock.exists(cpn) Then
|
||||||
|
If dictStock(cpn) < shortageQty Then
|
||||||
|
priority = "中"
|
||||||
|
wsDest.Cells(destRow, 15).Value = "中"
|
||||||
|
wsDest.Cells(destRow, 15).Interior.Color = RGB(255, 192, 0)
|
||||||
|
wsDest.Cells(destRow, 16).Value = "库存不足：核对备料需求"
|
||||||
|
Else
|
||||||
|
priority = "低"
|
||||||
|
wsDest.Cells(destRow, 15).Value = "低"
|
||||||
|
wsDest.Cells(destRow, 15).Interior.Color = RGB(0, 176, 80)
|
||||||
|
wsDest.Cells(destRow, 16).Value = "正常：库存可覆盖"
|
||||||
|
End If
|
||||||
|
Else
|
||||||
|
priority = "低"
|
||||||
|
wsDest.Cells(destRow, 15).Value = "低"
|
||||||
|
wsDest.Cells(destRow, 15).Interior.Color = RGB(0, 176, 80)
|
||||||
|
wsDest.Cells(destRow, 16).Value = "正常"
|
||||||
|
End If
|
||||||
|
|
||||||
|
' 备注
|
||||||
|
If dictQS.exists(cpn) Then
|
||||||
|
wsDest.Cells(destRow, 17).Value = "qs有订单"
|
||||||
|
Else
|
||||||
|
wsDest.Cells(destRow, 17).Value = "qs无订单"
|
||||||
|
End If
|
||||||
|
|
||||||
|
destRow = destRow + 1
|
||||||
|
|
||||||
|
NextRow:
|
||||||
|
Next i
|
||||||
|
|
||||||
|
' ---- 格式调整 ----
|
||||||
|
wsDest.Columns.AutoFit
|
||||||
|
wsDest.Range("A1").AutoFilter
|
||||||
|
|
||||||
|
' 冻结首行
|
||||||
|
wsDest.Activate
|
||||||
|
ActiveWindow.FreezePanes = False
|
||||||
|
wsDest.Rows(1).Select
|
||||||
|
ActiveWindow.FreezePanes = True
|
||||||
|
|
||||||
|
' ---- 完成 ----
|
||||||
|
Application.StatusBar = False
|
||||||
|
MsgBox "缺料交期总表已生成！" & vbCrLf & _
|
||||||
|
"共 " & (destRow - 2) & " 条记录" & vbCrLf & _
|
||||||
|
"高优先级：红色标注" & vbCrLf & _
|
||||||
|
"中优先级：橙色标注" & vbCrLf & _
|
||||||
|
"低优先级：绿色标注", vbInformation, "缺料交期总表"
|
||||||
|
|
||||||
|
GoTo CleanUp
|
||||||
|
|
||||||
|
ErrorHandler:
|
||||||
|
MsgBox "错误 " & Err.Number & "：" & Err.Description, vbCritical
|
||||||
|
|
||||||
|
CleanUp:
|
||||||
|
OptimizeVBA False
|
||||||
|
Set wsSource = Nothing
|
||||||
|
Set wsDest = Nothing
|
||||||
|
Set wsQS = Nothing
|
||||||
|
Set wsTMH = Nothing
|
||||||
|
Set ws0000 = Nothing
|
||||||
|
Set wsKCB = Nothing
|
||||||
|
Set dictQS = Nothing
|
||||||
|
Set dictTMH = Nothing
|
||||||
|
Set dictATP = Nothing
|
||||||
|
Set dictStock = Nothing
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
' ============================================================================
|
||||||
|
' 方案 A：计算缺料表优先级（更新 缺料 表 R 列）
|
||||||
|
' ============================================================================
|
||||||
|
|
||||||
|
Sub UpdateShortagePriority()
|
||||||
|
' 更新「缺料」工作表的 R 列（优先级）和 P 列（确认交期）
|
||||||
|
' 来源：qs 表的确认交期
|
||||||
|
|
||||||
|
Dim wsShortage As Worksheet
|
||||||
|
Dim wsQS As Worksheet
|
||||||
|
Dim ws0000 As Worksheet
|
||||||
|
Dim lastRow As Long, lastRowQS As Long
|
||||||
|
Dim i As Long, j As Long
|
||||||
|
Dim cpn As String
|
||||||
|
Dim confirmedDate As String
|
||||||
|
Dim confirmedQty As Double
|
||||||
|
Dim shortageQty As Double
|
||||||
|
Dim poQty As Double
|
||||||
|
Dim dictQS As Object
|
||||||
|
|
||||||
|
OptimizeVBA True
|
||||||
|
On Error GoTo ErrorHandler
|
||||||
|
|
||||||
|
' ---- 检查工作表 ----
|
||||||
|
If Not WorksheetExists("缺料") Then
|
||||||
|
MsgBox "「缺料」工作表不存在！", vbExclamation
|
||||||
|
GoTo CleanUp
|
||||||
|
End If
|
||||||
|
Set wsShortage = ThisWorkbook.Worksheets("缺料")
|
||||||
|
|
||||||
|
' ---- 建立 qs 数据字典 ----
|
||||||
|
Set dictQS = CreateObject("Scripting.Dictionary")
|
||||||
|
If WorksheetExists("qs") Then
|
||||||
|
Set wsQS = ThisWorkbook.Worksheets("qs")
|
||||||
|
lastRowQS = wsQS.Cells(wsQS.Rows.Count, "E").End(xlUp).Row
|
||||||
|
|
||||||
|
For i = 2 To lastRowQS
|
||||||
|
cpn = Trim(CStr(wsQS.Cells(i, 5).Value)) ' E列 = 茂瑞料号
|
||||||
|
If cpn <> "" Then
|
||||||
|
confirmedDate = Trim(CStr(wsQS.Cells(i, 10).Value)) ' J列 = ETD
|
||||||
|
confirmedQty = Val(CStr(wsQS.Cells(i, 11).Value)) ' K列 = 数量
|
||||||
|
|
||||||
|
If Not dictQS.exists(cpn) Then
|
||||||
|
dictQS.Add cpn, CreateObject("Scripting.Dictionary")
|
||||||
|
End If
|
||||||
|
dictQS(cpn).Add "ETD", confirmedDate
|
||||||
|
dictQS(cpn).Add "Qty", confirmedQty
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
End If
|
||||||
|
|
||||||
|
' ---- 获取 0000 的 PO 数据 ----
|
||||||
|
Dim dictPO As Object
|
||||||
|
Set dictPO = CreateObject("Scripting.Dictionary")
|
||||||
|
If WorksheetExists("0000") Then
|
||||||
|
Dim ws0000 As Worksheet
|
||||||
|
Set ws0000 = ThisWorkbook.Worksheets("0000")
|
||||||
|
Dim lastRow0000 As Long
|
||||||
|
lastRow0000 = ws0000.Cells(ws0000.Rows.Count, "A").End(xlUp).Row
|
||||||
|
|
||||||
|
For i = 3 To lastRow0000
|
||||||
|
cpn = Trim(CStr(ws0000.Cells(i, 1).Value))
|
||||||
|
poQty = Val(CStr(ws0000.Cells(i, 14).Value)) ' N列 = PO
|
||||||
|
If cpn <> "" Then dictPO.Add cpn, poQty
|
||||||
|
Next i
|
||||||
|
End If
|
||||||
|
|
||||||
|
' ---- 更新缺料表 ----
|
||||||
|
lastRow = wsShortage.Cells(wsShortage.Rows.Count, "B").End(xlUp).Row
|
||||||
|
|
||||||
|
' 确保 P、Q、R 列有表头
|
||||||
|
If wsShortage.Cells(3, 16).Value = "" Then wsShortage.Cells(3, 16).Value = "交期" ' P列
|
||||||
|
If wsShortage.Cells(3, 17).Value = "" Then wsShortage.Cells(3, 17).Value = "预计到货" ' Q列
|
||||||
|
If wsShortage.Cells(3, 18).Value = "" Then wsShortage.Cells(3, 18).Value = "优先级" ' R列
|
||||||
|
|
||||||
|
For i = 4 To lastRow
|
||||||
|
cpn = Trim(CStr(wsShortage.Cells(i, 2).Value)) ' B列 = CPN
|
||||||
|
If cpn = "" Or cpn = "0" Then GoTo NextShortage
|
||||||
|
|
||||||
|
' ---- 回填确认交期 (P列) 和预计到货 (Q列) ----
|
||||||
|
If dictQS.exists(cpn) Then
|
||||||
|
wsShortage.Cells(i, 16).Value = dictQS(cpn)("ETD") ' P列 = 交期
|
||||||
|
wsShortage.Cells(i, 17).Value = dictQS(cpn)("Qty") ' Q列 = 预计到货
|
||||||
|
Else
|
||||||
|
wsShortage.Cells(i, 16).Value = "待确认"
|
||||||
|
wsShortage.Cells(i, 17).Value = 0
|
||||||
|
End If
|
||||||
|
|
||||||
|
' ---- 计算优先级 (R列) ----
|
||||||
|
shortageQty = Val(CStr(wsShortage.Cells(i, 7).Value)) ' G列 = 结余/欠料
|
||||||
|
If dictPO.exists(cpn) Then
|
||||||
|
poQty = dictPO(cpn)
|
||||||
|
Else
|
||||||
|
poQty = Val(CStr(wsShortage.Cells(i, 10).Value)) ' J列 = PO
|
||||||
|
End If
|
||||||
|
|
||||||
|
If shortageQty < 0 And poQty = 0 Then
|
||||||
|
wsShortage.Cells(i, 18).Value = "高" ' R列 = 优先级
|
||||||
|
wsShortage.Cells(i, 18).Interior.Color = RGB(255, 0, 0)
|
||||||
|
wsShortage.Cells(i, 18).Font.Color = RGB(255, 255, 255)
|
||||||
|
ElseIf shortageQty < 0 And poQty > 0 Then
|
||||||
|
wsShortage.Cells(i, 18).Value = "中"
|
||||||
|
wsShortage.Cells(i, 18).Interior.Color = RGB(255, 192, 0)
|
||||||
|
ElseIf shortageQty >= 0 Then
|
||||||
|
wsShortage.Cells(i, 18).Value = "低"
|
||||||
|
wsShortage.Cells(i, 18).Interior.Color = RGB(0, 176, 80)
|
||||||
|
wsShortage.Cells(i, 18).Font.Color = RGB(255, 255, 255)
|
||||||
|
End If
|
||||||
|
|
||||||
|
NextShortage:
|
||||||
|
Next i
|
||||||
|
|
||||||
|
MsgBox "缺料表优先级已更新！" & vbCrLf & _
|
||||||
|
"P列：确认交期（来自qs）" & vbCrLf & _
|
||||||
|
"Q列：预计到货数量" & vbCrLf & _
|
||||||
|
"R列：优先级（高=红色，中=橙色，低=绿色）", vbInformation
|
||||||
|
GoTo CleanUp
|
||||||
|
|
||||||
|
ErrorHandler:
|
||||||
|
MsgBox "错误 " & Err.Number & "：" & Err.Description, vbCritical
|
||||||
|
|
||||||
|
CleanUp:
|
||||||
|
OptimizeVBA False
|
||||||
|
Set wsShortage = Nothing
|
||||||
|
Set wsQS = Nothing
|
||||||
|
Set ws0000 = Nothing
|
||||||
|
Set dictQS = Nothing
|
||||||
|
Set dictPO = Nothing
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
' ============================================================================
|
||||||
|
' 方案 B：从 qs 回填确认交期到缺料表（P 列）
|
||||||
|
' ============================================================================
|
||||||
|
|
||||||
|
Sub FillConfirmedDelivery()
|
||||||
|
' 将 qs 表中有确认交期的料号回填到「缺料」表的 P 列
|
||||||
|
' 前提：qs 表 J 列（ETD）已有数据
|
||||||
|
|
||||||
|
Dim wsQS As Worksheet
|
||||||
|
Dim wsShortage As Worksheet
|
||||||
|
Dim lastRowQS As Long, lastRowS As Long
|
||||||
|
Dim dict As Object
|
||||||
|
Dim i As Long, j As Long
|
||||||
|
Dim cpn As String
|
||||||
|
Dim confirmedDate As String
|
||||||
|
Dim confirmedQty As Double
|
||||||
|
Dim foundCount As Long
|
||||||
|
Dim notFoundCount As Long
|
||||||
|
|
||||||
|
OptimizeVBA True
|
||||||
|
On Error GoTo ErrorHandler
|
||||||
|
|
||||||
|
If Not WorksheetExists("qs") Then
|
||||||
|
MsgBox "「qs」工作表不存在！", vbExclamation
|
||||||
|
GoTo CleanUp
|
||||||
|
End If
|
||||||
|
If Not WorksheetExists("缺料") Then
|
||||||
|
MsgBox "「缺料」工作表不存在！", vbExclamation
|
||||||
|
GoTo CleanUp
|
||||||
|
End If
|
||||||
|
|
||||||
|
Set wsQS = ThisWorkbook.Worksheets("qs")
|
||||||
|
Set wsShortage = ThisWorkbook.Worksheets("缺料")
|
||||||
|
|
||||||
|
' ---- 建立 qs 数据字典 ----
|
||||||
|
Set dict = CreateObject("Scripting.Dictionary")
|
||||||
|
lastRowQS = wsQS.Cells(wsQS.Rows.Count, "E").End(xlUp).Row
|
||||||
|
|
||||||
|
For i = 2 To lastRowQS
|
||||||
|
cpn = Trim(CStr(wsQS.Cells(i, 5).Value)) ' E列 = 茂瑞料号
|
||||||
|
If cpn <> "" Then
|
||||||
|
confirmedDate = Trim(CStr(wsQS.Cells(i, 10).Value)) ' J列 = ETD
|
||||||
|
confirmedQty = Val(CStr(wsQS.Cells(i, 11).Value)) ' K列 = 数量
|
||||||
|
|
||||||
|
If confirmedDate <> "" Then
|
||||||
|
' 同一料号多条 PO，累加数量
|
||||||
|
If dict.exists(cpn) Then
|
||||||
|
dict(cpn)("Qty") = dict(cpn)("Qty") + confirmedQty
|
||||||
|
' 交期取最早
|
||||||
|
If confirmedDate < dict(cpn)("ETD") Then
|
||||||
|
dict(cpn)("ETD") = confirmedDate
|
||||||
|
End If
|
||||||
|
Else
|
||||||
|
dict.Add cpn, CreateObject("Scripting.Dictionary")
|
||||||
|
dict(cpn).Add "ETD", confirmedDate
|
||||||
|
dict(cpn).Add "Qty", confirmedQty
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
|
||||||
|
' ---- 回填到缺料表 P、Q 列 ----
|
||||||
|
lastRowS = wsShortage.Cells(wsShortage.Rows.Count, "B").End(xlUp).Row
|
||||||
|
foundCount = 0
|
||||||
|
notFoundCount = 0
|
||||||
|
|
||||||
|
For i = 4 To lastRowS
|
||||||
|
cpn = Trim(CStr(wsShortage.Cells(i, 2).Value)) ' B列 = CPN
|
||||||
|
If cpn = "" Or cpn = "0" Then GoTo NextItem
|
||||||
|
|
||||||
|
If dict.exists(cpn) Then
|
||||||
|
wsShortage.Cells(i, 16).Value = dict(cpn)("ETD") ' P列 = 交期
|
||||||
|
wsShortage.Cells(i, 17).Value = dict(cpn)("Qty") ' Q列 = 数量
|
||||||
|
foundCount = foundCount + 1
|
||||||
|
Else
|
||||||
|
notFoundCount = notFoundCount + 1
|
||||||
|
End If
|
||||||
|
|
||||||
|
NextItem:
|
||||||
|
Next i
|
||||||
|
|
||||||
|
MsgBox "交期回填完成！" & vbCrLf & _
|
||||||
|
"已匹配并回填：" & foundCount & " 条" & vbCrLf & _
|
||||||
|
"qs 中无此料号：" & notFoundCount & " 条", vbInformation
|
||||||
|
|
||||||
|
GoTo CleanUp
|
||||||
|
|
||||||
|
ErrorHandler:
|
||||||
|
MsgBox "错误 " & Err.Number & "：" & Err.Description, vbCritical
|
||||||
|
|
||||||
|
CleanUp:
|
||||||
|
OptimizeVBA False
|
||||||
|
Set wsQS = Nothing
|
||||||
|
Set wsShortage = Nothing
|
||||||
|
Set dict = Nothing
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
' ============================================================================
|
||||||
|
' 方案 B：TMH 入库后同步状态到 qs
|
||||||
|
' ============================================================================
|
||||||
|
|
||||||
|
Sub SyncTMHToQS()
|
||||||
|
' 当 TMH 表有实际入库后，更新 qs 表中对应料号的已交货数量
|
||||||
|
' 逻辑：
|
||||||
|
' 1. 读取 TMH 的料号和数量
|
||||||
|
' 2. 在 qs 中找到对应料号的订单
|
||||||
|
' 3. 减少 qs 中该料号的剩余未交数量
|
||||||
|
|
||||||
|
Dim wsTMH As Worksheet
|
||||||
|
Dim wsQS As Worksheet
|
||||||
|
Dim lastRowTMH As Long, lastRowQS As Long
|
||||||
|
Dim dictTMH As Object
|
||||||
|
Dim i As Long, j As Long
|
||||||
|
Dim cpn As String
|
||||||
|
Dim inQty As Double
|
||||||
|
Dim matchCount As Long
|
||||||
|
Dim unmatchCount As Long
|
||||||
|
|
||||||
|
OptimizeVBA True
|
||||||
|
On Error GoTo ErrorHandler
|
||||||
|
|
||||||
|
If Not WorksheetExists("TMH") Then
|
||||||
|
MsgBox "「TMH」工作表不存在！", vbExclamation
|
||||||
|
GoTo CleanUp
|
||||||
|
End If
|
||||||
|
If Not WorksheetExists("qs") Then
|
||||||
|
MsgBox "「qs」工作表不存在！", vbExclamation
|
||||||
|
GoTo CleanUp
|
||||||
|
End If
|
||||||
|
|
||||||
|
Set wsTMH = ThisWorkbook.Worksheets("TMH")
|
||||||
|
Set wsQS = ThisWorkbook.Worksheets("qs")
|
||||||
|
|
||||||
|
' ---- 建立 TMH 汇总字典 ----
|
||||||
|
Set dictTMH = CreateObject("Scripting.Dictionary")
|
||||||
|
lastRowTMH = wsTMH.Cells(wsTMH.Rows.Count, "E").End(xlUp).Row
|
||||||
|
|
||||||
|
For i = 2 To lastRowTMH
|
||||||
|
cpn = Trim(CStr(wsTMH.Cells(i, 5).Value)) ' E列 = 料号
|
||||||
|
inQty = Val(CStr(wsTMH.Cells(i, 6).Value)) ' F列 = 数量
|
||||||
|
|
||||||
|
If cpn <> "" Then
|
||||||
|
If dictTMH.exists(cpn) Then
|
||||||
|
dictTMH(cpn) = dictTMH(cpn) + inQty
|
||||||
|
Else
|
||||||
|
dictTMH.Add cpn, inQty
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
|
||||||
|
' ---- 在 qs 中更新已交货 ----
|
||||||
|
lastRowQS = wsQS.Cells(wsQS.Rows.Count, "E").End(xlUp).Row
|
||||||
|
matchCount = 0
|
||||||
|
|
||||||
|
For i = 2 To lastRowQS
|
||||||
|
cpn = Trim(CStr(wsQS.Cells(i, 5).Value)) ' E列 = 茂瑞料号
|
||||||
|
If cpn <> "" And dictTMH.exists(cpn) Then
|
||||||
|
' K列 = 厂商回复数量（已交货），L列 = 交期确认
|
||||||
|
wsQS.Cells(i, 11).Value = dictTMH(cpn) ' 标记已交货数量
|
||||||
|
wsQS.Cells(i, 12).Value = "Y" ' 标记已确认
|
||||||
|
matchCount = matchCount + 1
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
|
||||||
|
MsgBox "TMH 已同步到 qs！" & vbCrLf & _
|
||||||
|
"共更新 " & matchCount & " 条记录", vbInformation
|
||||||
|
|
||||||
|
GoTo CleanUp
|
||||||
|
|
||||||
|
ErrorHandler:
|
||||||
|
MsgBox "错误 " & Err.Number & "：" & Err.Description, vbCritical
|
||||||
|
|
||||||
|
CleanUp:
|
||||||
|
OptimizeVBA False
|
||||||
|
Set wsTMH = Nothing
|
||||||
|
Set wsQS = Nothing
|
||||||
|
Set dictTMH = Nothing
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
' ============================================================================
|
||||||
|
' 一键刷新：运行所有优化宏（推荐绑定 Ctrl+Shift+R）
|
||||||
|
' ============================================================================
|
||||||
|
|
||||||
|
Sub RefreshAllData()
|
||||||
|
' 按顺序执行所有优化宏
|
||||||
|
' 1. 更新缺料优先级 + 回填交期
|
||||||
|
' 2. 生成缺料交期总表
|
||||||
|
|
||||||
|
Dim startTime As Double
|
||||||
|
startTime = Timer
|
||||||
|
|
||||||
|
Application.StatusBar = "正在刷新数据..."
|
||||||
|
|
||||||
|
' 步骤1：回填 qs 交期到缺料表
|
||||||
|
Application.StatusBar = "步骤 1/3：回填确认交期..."
|
||||||
|
Call FillConfirmedDelivery
|
||||||
|
|
||||||
|
' 步骤2：更新优先级
|
||||||
|
Application.StatusBar = "步骤 2/3：计算优先级..."
|
||||||
|
Call UpdateShortagePriority
|
||||||
|
|
||||||
|
' 步骤3：生成交期总表
|
||||||
|
Application.StatusBar = "步骤 3/3：生成缺料交期总表..."
|
||||||
|
Call CreateShortageDeliveryReport
|
||||||
|
|
||||||
|
Application.StatusBar = False
|
||||||
|
|
||||||
|
MsgBox "数据刷新完成！" & vbCrLf & _
|
||||||
|
"耗时：" & Format(Timer - startTime, "0.00") & " 秒" & vbCrLf & _
|
||||||
|
"请查看「缺料交期总表」了解缺料与交期全貌", vbInformation, "刷新完成"
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
' ============================================================================
|
||||||
|
' 辅助函数
|
||||||
|
' ============================================================================
|
||||||
|
|
||||||
|
Function WorksheetExists(sheetName As String) As Boolean
|
||||||
|
On Error Resume Next
|
||||||
|
WorksheetExists = Not ThisWorkbook.Sheets(sheetName) Is Nothing
|
||||||
|
On Error GoTo 0
|
||||||
|
End Function
|
||||||
|
|
||||||
|
Sub OptimizeVBA(Optimize As Boolean)
|
||||||
|
With Application
|
||||||
|
If Optimize Then
|
||||||
|
.ScreenUpdating = False
|
||||||
|
.Calculation = xlCalculationManual
|
||||||
|
.DisplayAlerts = False
|
||||||
|
.EnableEvents = False
|
||||||
|
.StatusBar = "处理中..."
|
||||||
|
Else
|
||||||
|
.ScreenUpdating = True
|
||||||
|
.Calculation = xlCalculationAutomatic
|
||||||
|
.DisplayAlerts = True
|
||||||
|
.EnableEvents = True
|
||||||
|
.StatusBar = False
|
||||||
|
End If
|
||||||
|
End With
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
' ============================================================================
|
||||||
|
' 快捷键设置说明（在 VBA 编辑器中设置）
|
||||||
|
' ============================================================================
|
||||||
|
' 1. 在 VBA 编辑器中，点击 ThisWorkbook
|
||||||
|
' 2. 选择 "工具" -> "宏" -> "RefreshAllData" -> "选项"
|
||||||
|
' 3. 设置快捷键为 Ctrl+Shift+R
|
||||||
|
' 4. 保存后，每次按 Ctrl+Shift+R 即可一键刷新所有数据
|
||||||
|
' ============================================================================
|
||||||
45
README.md
Normal file
45
README.md
Normal file
@ -0,0 +1,45 @@
|
|||||||
|
# Marui_Work_Optimize
|
||||||
|
# PMC 物控优化方案 — 缺料交期总表 + 数据链路打通 + 字段补全
|
||||||
|
|
||||||
|
## 📋 优化内容
|
||||||
|
|
||||||
|
### 方案 A：补全缺料表字段
|
||||||
|
在 `缺料` 表增加/完善列：
|
||||||
|
- **P列 = 确认交期**：从 qs 表或手动填入
|
||||||
|
- **Q列 = 预计到货数量**：qs 厂商回复数量
|
||||||
|
- **R列 = 跟催优先级**：自动计算高/中/低
|
||||||
|
- **S列 = 采购窗口**：跳转到 qs 对应行
|
||||||
|
|
||||||
|
优先级规则：
|
||||||
|
- 高优先级：结余/欠料 < 0 且 PO = 0（无订单）
|
||||||
|
- 中优先级：结余/欠料 < 0 且 PO > 0（有订单但不够）
|
||||||
|
- 低优先级：结余/欠料 >= 0 但 备料不足
|
||||||
|
|
||||||
|
### 方案 B：打通数据链路
|
||||||
|
```
|
||||||
|
qs 表完善后 → 自动回填 → 缺料.P (确认交期)
|
||||||
|
TMH.C 录入后 → 自动更新 → qs 的实际到货状态
|
||||||
|
0000.L/T内缺料 → 自动标记 → 缺料 优先级
|
||||||
|
```
|
||||||
|
|
||||||
|
### 方案 C：新建缺料交期总表
|
||||||
|
新增 `缺料交期总表` 工作表，VBA 自动汇总所有关键信息。
|
||||||
|
|
||||||
|
## 宏列表
|
||||||
|
|
||||||
|
| 宏 | 说明 |
|
||||||
|
|----|------|
|
||||||
|
| `UpdateShortagePriority` | 方案A：计算缺料表优先级 |
|
||||||
|
| `FillConfirmedDelivery` | 方案B：从qs回填确认交期到缺料表 |
|
||||||
|
| `CreateShortageDeliveryReport` | 方案C：生成缺料交期总表 |
|
||||||
|
| `RefreshAllData` | 一键刷新所有数据（推荐绑定快捷键） |
|
||||||
|
| `SyncTMHToQS` | 方案B：TMH入库后同步状态到qs |
|
||||||
|
| `WorksheetExists` | 工具函数：检查工作表是否存在 |
|
||||||
|
| `OptimizeVBA` | 工具函数：性能优化开关 |
|
||||||
|
|
||||||
|
## 使用说明
|
||||||
|
|
||||||
|
1. 将本模块复制到 xlsm 文件的 VBA 编辑器
|
||||||
|
2. 推荐绑定 `RefreshAllData` 到快捷键（如 Ctrl+Shift+R）
|
||||||
|
3. 每次查看缺料交期前先运行刷新宏
|
||||||
|
4. qs / ql / TMH 数据由采购/仓储录入，物控主要使用 `缺料交期总表`
|
||||||
126
架构说明.md
Normal file
126
架构说明.md
Normal file
@ -0,0 +1,126 @@
|
|||||||
|
# 缺料交期系统 — 使用手册
|
||||||
|
|
||||||
|
## 📌 快速开始
|
||||||
|
|
||||||
|
### 第一次使用
|
||||||
|
1. 打开 `全機型_日報表.xlsm`
|
||||||
|
2. 按 `Alt + F11` 进入 VBA 编辑器
|
||||||
|
3. 新建模块，粘贴 `PMC_缺料交期优化.bas` 的内容
|
||||||
|
4. 保存
|
||||||
|
|
||||||
|
### 每次查看缺料交期
|
||||||
|
1. **按 `Ctrl+Shift+R`**（需在 VBA 中设置）
|
||||||
|
2. 或手动运行 `RefreshAllData` 宏
|
||||||
|
3. 查看自动生成的 **「缺料交期总表」**
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 📊 系统架构
|
||||||
|
|
||||||
|
### 现状数据流（优化前）
|
||||||
|
```
|
||||||
|
qs（PO确认交期）→ 需手动填入缺料表
|
||||||
|
TMH（实际入库）→ 需手动更新qs
|
||||||
|
缺料表 → 交期列全空
|
||||||
|
```
|
||||||
|
|
||||||
|
### 优化后数据流
|
||||||
|
```
|
||||||
|
qs（PO确认交期）
|
||||||
|
↓ FillConfirmedDelivery()
|
||||||
|
缺料.P列（确认交期） + Q列（预计到货）
|
||||||
|
↓
|
||||||
|
UpdateShortagePriority() → 缺料.R列（优先级）
|
||||||
|
↓
|
||||||
|
CreateShortageDeliveryReport() → 缺料交期总表（汇总视图）
|
||||||
|
↓
|
||||||
|
TMH（入库记录）
|
||||||
|
↓ SyncTMHToQS() → qs.K列（已交货数量）
|
||||||
|
```
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 📋 各工作表职责
|
||||||
|
|
||||||
|
| 工作表 | 数据来源 | 责任人 | 本系统操作 |
|
||||||
|
|--------|---------|--------|-----------|
|
||||||
|
| qs | 采购录入PO和ETD | 采购 | 读取ETD，回填交期 |
|
||||||
|
| TMH | 仓储录入实际入库 | 仓储 | 读取入库，同步入qs |
|
||||||
|
| 缺料 | 系统生成或手工 | PMC | 回填P/Q/R列 |
|
||||||
|
| 缺料交期总表 | 自动汇总 | PMC | **查看为主** |
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 🎯 核心使用场景
|
||||||
|
|
||||||
|
### 场景1：查看缺料和交期
|
||||||
|
**操作：** 按 `Ctrl+Shift+R` → 查看「缺料交期总表」
|
||||||
|
|
||||||
|
「缺料交期总表」包含：
|
||||||
|
- 料号、机种、IC厂商
|
||||||
|
- 结余/欠料数量
|
||||||
|
- PO未交量
|
||||||
|
- TMH待提数量
|
||||||
|
- L/T内缺料
|
||||||
|
- **确认交期（从qs回填）**
|
||||||
|
- **预计到货数量**
|
||||||
|
- **优先级（高/中/低）**
|
||||||
|
- 跟催建议
|
||||||
|
|
||||||
|
### 场景2：采购回复交期后
|
||||||
|
**操作：** 在qs表填入ETD → 运行 `FillConfirmedDelivery`
|
||||||
|
|
||||||
|
回填内容：
|
||||||
|
- 缺料.P列 = qs.J列（确认交期）
|
||||||
|
- 缺料.Q列 = qs.K列（预计数量）
|
||||||
|
|
||||||
|
### 场景3：料到入库后
|
||||||
|
**操作：** TMH录入 → 运行 `SyncTMHToQS`
|
||||||
|
|
||||||
|
效果：
|
||||||
|
- qs.K列标记已交货数量
|
||||||
|
- qs.L列标记"已确认"
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 🚨 优先级说明
|
||||||
|
|
||||||
|
| 优先级 | 条件 | 颜色 | 动作 |
|
||||||
|
|--------|------|------|------|
|
||||||
|
| **高** | 结余<0 且 PO=0 | 红色 | 紧急跟催，立即联系采购 |
|
||||||
|
| **中** | 结余<0 且 PO>0 | 橙色 | 确认PO交期，追踪厂商回复 |
|
||||||
|
| **低** | 结余>=0 | 绿色 | 正常，核对备料需求即可 |
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## ⚠️ 注意事项
|
||||||
|
|
||||||
|
1. **qs 表是数据源**：本系统从 qs 读取交期，qs 数据必须由采购及时录入
|
||||||
|
2. **TMH 是入库依据**：实际入库数量通过 TMH 同步到 qs
|
||||||
|
3. **交期总表只读**：建议不要手动编辑总表，每次用 `RefreshAllData` 刷新
|
||||||
|
4. **日期格式**：qs.J 列（ETD）建议使用 Excel 日期格式，否则匹配可能失败
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 🔧 维护指南
|
||||||
|
|
||||||
|
### 快捷键设置
|
||||||
|
```
|
||||||
|
1. Alt + F11 打开 VBA 编辑器
|
||||||
|
2. 在模块上右键 → 宏 → RefreshAllData → 选项
|
||||||
|
3. 快捷键输入：Shift+R（即 Ctrl+Shift+R）
|
||||||
|
```
|
||||||
|
|
||||||
|
### 添加新字段
|
||||||
|
如需在「缺料交期总表」增加列：
|
||||||
|
1. 在 `CreateShortageDeliveryReport()` 的 `headers` 数组添加列名
|
||||||
|
2. 在对应位置写入数据
|
||||||
|
3. 运行刷新
|
||||||
|
|
||||||
|
### 修改优先级规则
|
||||||
|
在 `UpdateShortagePriority()` 或 `CreateShortageDeliveryReport()` 中修改：
|
||||||
|
```vba
|
||||||
|
' 高优先级规则示例
|
||||||
|
If shortageQty < 0 And poQty = 0 Then
|
||||||
|
priority = "高"
|
||||||
|
```
|
||||||
Loading…
Reference in New Issue
Block a user