From 5ec5e27cae6fc43d377c9ba70338ad709538c6d3 Mon Sep 17 00:00:00 2001 From: 1803560007 <1803560007@qq.com> Date: Tue, 7 Apr 2026 12:00:25 +0800 Subject: [PATCH] =?UTF-8?q?Initial=20commit:=20PMC=E7=89=A9=E6=8E=A7?= =?UTF-8?q?=E4=BC=98=E5=8C=96=E6=96=B9=E6=A1=88=20A+B+C=20(2026-04-07)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- PMC_缺料交期优化.bas | 675 +++++++++++++++++++++++++++++++++++++++++++ README.md | 45 +++ 架构说明.md | 126 ++++++++ 3 files changed, 846 insertions(+) create mode 100644 PMC_缺料交期优化.bas create mode 100644 README.md create mode 100644 架构说明.md diff --git a/PMC_缺料交期优化.bas b/PMC_缺料交期优化.bas new file mode 100644 index 0000000..5f57401 --- /dev/null +++ b/PMC_缺料交期优化.bas @@ -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 即可一键刷新所有数据 +' ============================================================================ diff --git a/README.md b/README.md new file mode 100644 index 0000000..c6fac60 --- /dev/null +++ b/README.md @@ -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 数据由采购/仓储录入，物控主要使用 `缺料交期总表` diff --git a/架构说明.md b/架构说明.md new file mode 100644 index 0000000..9aca95e --- /dev/null +++ b/架构说明.md @@ -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 = "高" +```