{"attrs":"{\"custom-publish-status\":\"publish\",\"custom-publish-time\":\"1759806028841\",\"custom-expires\":\"0\",\"custom-slug\":\"\"}","title":"Excel物料需求与库存分析系统","editorDom":"
一、如和使用
​
启用宏功能
​
​
​
将库存数据全选覆盖粘贴到​料件库存报表​工作表
​
​
将BOM数据粘贴到​BOM​工作表
​
​
将预测数据粘贴到​Focest​工作表
​
​
​
按​Alt+F8​打开宏对话框
​
​
​
选择宏​A​
​
​
​
点击​运行​按钮
​
​
在0000工作表查看所有汇总数据
​
​
​
重要注意事项：
​
保持原始列位置不变，避免修改列顺序
​
​
​
​
二、文件结构
​
​
​ \"image\" ​
​
工作表名称功能描述数据来源更新频率
料件库存报表存放SAP导出的库存数据SAP系统导出每日/每周
BOMBOM表数据SAP系统导出物料变更时
Focest存放预测需求数据预测系统导出每周
Output宏运行后生成的需求计算结果系统自动生成每次运行宏
Cutput宏运行后生成的需求透视表系统自动生成每次运行宏
Unmatched宏运行后生成的未匹配料号清单系统自动生成每次运行宏
0000主分析报表（最终查看页面）综合所有数据实时更新
​
步骤1：准备源数据
​
库存报表数据要求：
​
必须包含的字段：料号、库存量、待验量、需求量、采购订单量、采购申请量、提前期天数、最小订单量、结余量
​
​
数据格式：从SAP系统标准导出格式
​
​
直接整体覆盖粘贴
​
​
​ \"image\" ​
​
​
​
BOM表数据要求：
​
父料号、子料号、用量比例
​
​
完整的物料层级关系
​
​
​ \"image\" ​
​
​
​
Focest预测数据要求：
​
料号、LIC系数
​
​
56周的需求预测数据
​
​
基准日期信息
​
​
​
参数配置详解
​
单元格对应数据默认值数据源列说明
B1库存量2D列库存报表中库存所在列
C1待验量3E列库存报表中待验量所在列
D1需求量4F列库存报表中需求量所在列
E1PO量5G列库存报表中采购订单量所在列
F1PR量6H列库存报表中采购申请量所在列
G1LT天数7I列库存报表中提前期天数所在列
H1MOQ8J列库存报表中最小订单量所在列
I1结余量9K列库存报表中结余量所在列
​
如需更改数据提取列，直接修改B1:I1中的数字（如B1=3表示提取库存报表E列数据）
​
4. 0000工作表（主分析仪表板）
​
​ \"image\" ​
​
核心分析列说明
​
列标题公式业务含义
AP/N手工输入需要分析的料号
B庫存​​=VLOOKUP($A3,料件库存报表!$D:$BG,B$1,0)​当前库存数量
C待驗​​=VLOOKUP($A3,料件库存报表!$D:$BG,C$1,0)​在检验中的数量
D需求​​=VLOOKUP($A3,料件库存报表!$D:$BG,D$1,0)​当前需求量
EPO​​=VLOOKUP($A3,料件库存报表!$D:$BG,E$1,0)​采购在途订单量
FPR​​=VLOOKUP($A3,料件库存报表!$D:$BG,F$1,0)​采购申请量
G天数​​=VLOOKUP($A3,料件库存报表!$D:$BG,G$1,0)​物料提前期(天)
HMOQ​​=VLOOKUP($A3,料件库存报表!$D:$BG,H$1,0)​最小订购批量
I结余量​​=VLOOKUP($A3,料件库存报表!$D:$BG,I$1,0)​可用库存结余
JL/T+两周​​=ROUND(G3/7,0)+2​提前期周数+安全缓冲
K工单欠料​​=I3-SUM(...)​结余量减去提前期内需求
LL/T内需求​​=SUM(INDIRECT('P'&ROW()&':'&NT($J3+COLUMN($P$1)-1)&ROW()))​提前期内的总需求
M差异​​=I3-L3​库存与需求的差异
N-BH周需求​​=VLOOKUP($A5,Cutput!$A:$BH,Q$1,0)​各周预测需求数量
​
动态需求预测调整
​
通过修改​0000​工作表的​P2​日期，系统实现动态重算：
​
动态生成时间轴。 它通过计算一个基准周数，并利用列位置自动向右递增，从而快速创建出一系列连续的周序号。当基准日期变化时，整个周序列会自动更新。
​
​
​
VBA代码中文注释
​
子程序 A
​
vba
Sub A()\n ' 调用B子程序处理数据\n Call B\n ' 调用Q子程序生成数据透视表\n Call Q\nEnd Sub\n
​
子程序 B - 主要数据处理程序
​
vba
Sub B()\n ' 关闭屏幕更新、自动计算和事件处理以提高性能\n Application.ScreenUpdating = False\n Application.Calculation = xlCalculationManual\n Application.EnableEvents = False\n \n ' 定义工作表变量\n Dim wsFocest As Worksheet, wsBOM As Worksheet, wsOutput As Worksheet, wsUnmatched As Worksheet\n ' 定义行号变量\n Dim lastRowF As Long, lastRowB As Long, lastRowO As Long, lastRowU As Long\n ' 定义循环计数器\n Dim i As Long, j As Long, k As Long, col As Long\n ' 定义数据变量\n Dim keyPart As String, material As String, usage As Double\n Dim lic As Double, focestCol1 As String, focestCol2 As String\n ' 定义56周数据数组\n Dim weekValues(1 To 56) As Double\n ' 定义字典对象用于存储BOM数据和未匹配数据\n Dim dictBOM As Object, dictUnmatched As Object\n Dim materialData As Variant\n Dim key As Variant\n \n ' 创建字典对象\n Set dictBOM = CreateObject("Scripting.Dictionary")\n Set dictUnmatched = CreateObject("Scripting.Dictionary")\n \n ' 设置工作表引用\n Set wsFocest = ThisWorkbook.Sheets("Focest")\n Set wsBOM = ThisWorkbook.Sheets("BOM")\n \n ' 删除并重新创建输出工作表\n On Error Resume Next\n Application.DisplayAlerts = False\n ThisWorkbook.Sheets("Output").Delete\n ThisWorkbook.Sheets("Unmatched").Delete\n Application.DisplayAlerts = True\n On Error GoTo 0\n \n ' 创建新的输出工作表\n Set wsOutput = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))\n wsOutput.Name = "Output"\n Set wsUnmatched = ThisWorkbook.Sheets.Add(After:=wsOutput)\n wsUnmatched.Name = "Unmatched"\n \n ' 阶段1: 读取BOM数据到字典中\n lastRowB = wsBOM.Cells(wsBOM.Rows.Count, "A").End(xlUp).Row\n Dim bomData As Variant\n bomData = wsBOM.Range("A2:C" & lastRowB).Value\n \n ' 遍历BOM数据并填充字典\n For i = 1 To UBound(bomData, 1)\n keyPart = Trim(bomData(i, 1) & "")\n material = Trim(bomData(i, 2) & "")\n \n ' 安全处理使用量数值\n If IsNumeric(bomData(i, 3)) Then\n usage = CDbl(bomData(i, 3))\n Else\n usage = 0\n End If\n \n ' 如果关键部件和物料号都不为空，添加到字典\n If keyPart <> "" And material <> "" Then\n If Not dictBOM.Exists(keyPart) Then\n dictBOM.Add keyPart, New Collection\n End If\n dictBOM(keyPart).Add Array(material, usage)\n End If\n Next i\n \n ' 阶段2: 处理Focest数据 - 只处理有BOM匹配的行\n lastRowF = wsFocest.Cells(wsFocest.Rows.Count, "A").End(xlUp).Row\n Dim focestData As Variant\n focestData = wsFocest.Range("A2:BJ" & lastRowF).Value ' 列A到BJ (A, B + 56周)\n \n ' 预计算输出数据大小\n Dim outputRowCount As Long\n outputRowCount = 0\n For i = 1 To UBound(focestData, 1)\n keyPart = Trim(focestData(i, 1) & "")\n If keyPart <> "" And dictBOM.Exists(keyPart) Then\n outputRowCount = outputRowCount + dictBOM(keyPart).Count\n End If\n Next i\n \n ' 准备输出数组\n Dim outputData() As Variant\n ReDim outputData(1 To outputRowCount, 1 To 60) ' 4个固定列 + 56个周列\n \n lastRowO = 0\n \n ' 处理Focest数据\n For i = 1 To UBound(focestData, 1)\n keyPart = Trim(focestData(i, 1) & "")\n If keyPart = "" Then GoTo NextFocestRow\n \n ' 只处理有BOM匹配的行\n If dictBOM.Exists(keyPart) Then\n focestCol1 = focestData(i, 1) & ""\n focestCol2 = focestData(i, 2) & ""\n \n ' 安全处理LIC值\n If IsNumeric(focestData(i, 2)) Then\n lic = CDbl(focestData(i, 2))\n Else\n lic = 0\n End If\n \n ' 提取周数据并进行错误处理\n For j = 1 To 56\n If IsNumeric(focestData(i, j + 2)) Then\n weekValues(j) = CDbl(focestData(i, j + 2))\n Else\n weekValues(j) = 0\n End If\n Next j\n \n ' 处理匹配的BOM项目\n For k = 1 To dictBOM(keyPart).Count\n materialData = dictBOM(keyPart)(k)\n material = materialData(0)\n usage = materialData(1)\n lastRowO = lastRowO + 1\n \n ' 填充输出数据\n outputData(lastRowO, 1) = focestCol1\n outputData(lastRowO, 2) = focestCol2\n outputData(lastRowO, 3) = material\n outputData(lastRowO, 4) = usage\n \n ' 计算每周数据：周值 × LIC × 使用量\n For col = 1 To 56\n outputData(lastRowO, col + 4) = weekValues(col) * lic * usage\n Next col\n Next k\n End If\n \nNextFocestRow:\n Next i\n \n ' 阶段3: 单独处理没有BOM匹配的Focest行\n For i = 1 To UBound(focestData, 1)\n keyPart = Trim(focestData(i, 1) & "")\n If keyPart <> "" And Not dictBOM.Exists(keyPart) Then\n If Not dictUnmatched.Exists(keyPart) Then\n dictUnmatched.Add keyPart, True\n End If\n End If\n Next i\n \n ' 批量写入输出数据\n If outputRowCount > 0 Then\n wsOutput.Range("A2").Resize(outputRowCount, 60).Value = outputData\n End If\n \n ' 生成未匹配数据工作表\n wsUnmatched.Cells(1, 1).Value = "Unmatched Key Part Numbers"\n \n ' 写入未匹配的数据\n If dictUnmatched.Count > 0 Then\n Dim unmatchedData() As Variant\n ReDim unmatchedData(1 To dictUnmatched.Count, 1 To 1)\n i = 0\n For Each key In dictUnmatched.Keys\n i = i + 1\n unmatchedData(i, 1) = key\n Next key\n wsUnmatched.Range("A2").Resize(dictUnmatched.Count, 1).Value = unmatchedData\n End If\n \n ' 设置输出表的标题行\n wsOutput.Cells(1, 1).Value = "Focest Col1"\n wsOutput.Cells(1, 2).Value = "Focest Col2"\n wsOutput.Cells(1, 3).Value = "Material Number"\n wsOutput.Cells(1, 4).Value = "BOM Usage"\n For col = 1 To 56\n wsOutput.Cells(1, col + 4).Value = "Week" & col\n Next col\n \n ' 自动调整列宽\n wsOutput.Columns.AutoFit\n wsUnmatched.Columns.AutoFit\n \n ' 恢复Excel设置\n Application.ScreenUpdating = True\n Application.Calculation = xlCalculationAutomatic\n Application.EnableEvents = True\n \n ' 显示处理完成消息\n MsgBox "Processing completed! " & outputRowCount & " rows generated in Output sheet. " & _\n dictUnmatched.Count & " unmatched items found."\nEnd Sub\n
​
子程序 Q - 数据透视表生成程序
​
vba
Sub Q()\n ' 定义变量\n Dim wsSource As Worksheet, wsDest As Worksheet\n Dim pvtCache As PivotCache\n Dim pvtTable As PivotTable\n Dim lastRow As Long\n Dim SourceDataRange As Range\n Dim i As Long\n Dim fieldName As String\n Dim startTime As Double\n Dim dataField As PivotField\n\n ' 开始计时\n startTime = Timer\n\n ' 禁用Excel功能以提高性能\n OptimizeVBA True\n\n On Error GoTo ErrorHandler\n\n ' 检查源工作表是否存在\n If Not WorksheetExists("Output") Then\n MsgBox "Source worksheet 'Output' not found!", vbCritical\n GoTo CleanUp\n End If\n\n ' 设置源工作表引用\n Set wsSource = ThisWorkbook.Worksheets("Output")\n\n ' 如果目标工作表已存在则删除\n If WorksheetExists("Cutput") Then\n Application.DisplayAlerts = False\n ThisWorkbook.Worksheets("Cutput").Delete\n Application.DisplayAlerts = True\n End If\n\n ' 移除同名的现有数据透视表\n RemovePivotTable "WeeklySummaryPivot"\n\n ' 创建新的数据透视表工作表\n Set wsDest = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))\n wsDest.Name = "Cutput"\n\n ' 查找源工作表的最后一行数据\n lastRow = FindLastRow(wsSource)\n\n ' 验证是否有足够的数据\n If lastRow < 2 Then\n MsgBox "Insufficient data in source worksheet!", vbExclamation\n GoTo CleanUp\n End If\n\n ' 定义源数据范围\n Set SourceDataRange = wsSource.Range("A1:BH" & lastRow)\n\n ' 从源数据创建数据透视缓存\n Set pvtCache = ThisWorkbook.PivotCaches.Create( _\n SourceType:=xlDatabase, _\n sourceData:=SourceDataRange)\n\n ' 创建数据透视表\n Set pvtTable = pvtCache.CreatePivotTable( _\n TableDestination:=wsDest.Range("A3"), _\n tableName:="WeeklySummaryPivot")\n\n ' 配置数据透视表\n With pvtTable\n .ManualUpdate = True\n .RowAxisLayout xlTabularRow\n \n ' 添加行字段 - 物料号（C列）\n .AddFields RowFields:=wsSource.Cells(1, 3).Value\n \n ' 添加数据字段（E列到BH列）\n For i = 5 To 60\n fieldName = wsSource.Cells(1, i).Value\n \n If fieldName <> "" Then\n On Error Resume Next\n Set dataField = .PivotFields(fieldName)\n If Err.Number = 0 Then\n With dataField\n .Orientation = xlDataField\n .Function = xlSum\n .NumberFormat = "#,##0"\n \n If InStr(.Caption, "Sum of") = 0 Then\n .Caption = "Sum of " & fieldName\n End If\n End With\n Else\n Err.Clear\n End If\n On Error GoTo ErrorHandler\n End If\n Next i\n \n ' 应用格式设置\n .ShowTableStyleRowStripes = True\n .TableStyle2 = "PivotStyleMedium9"\n .ManualUpdate = False\n End With\n\n ' 添加标题和时间戳\n With wsDest\n .Range("A1").Value = "Weekly Summary Report"\n .Range("A1").Font.Bold = True\n .Range("A1").Font.Size = 14\n \n .Range("A2").Value = "Generated: " & Now()\n .Range("A2").Font.Italic = True\n End With\n\n ' 自动调整列宽\n If wsDest.UsedRange.Count > 1 Then\n wsDest.UsedRange.Columns.AutoFit\n End If\n\n ' 成功消息\n MsgBox "Pivot table created successfully in " & Format(Timer - startTime, "0.00") & _\n " seconds! Location: Worksheet " & wsDest.Name, vbInformation\n\nCleanUp:\n ' 清理和恢复设置\n OptimizeVBA False\n Set pvtTable = Nothing\n Set pvtCache = Nothing\n Set SourceDataRange = Nothing\n Set wsSource = Nothing\n Set wsDest = Nothing\n\n Exit Sub\n\nErrorHandler:\n ' 错误处理\n MsgBox "Error " & Err.Number & ": " & Err.Description & vbCrLf & _\n "Error occurred at line: " & Erl, vbCritical\n Resume CleanUp\nEnd Sub\n\n' 辅助函数：优化VBA性能\nSub OptimizeVBA(Optimize As Boolean)\n With Application\n If Optimize Then\n .ScreenUpdating = False\n .Calculation = xlCalculationManual\n .DisplayAlerts = False\n .EnableEvents = False\n .StatusBar = "Processing... Please wait"\n Else\n .ScreenUpdating = True\n .Calculation = xlCalculationAutomatic\n .DisplayAlerts = True\n .EnableEvents = True\n .StatusBar = False\n End If\n End With\nEnd Sub\n\n' 辅助函数：检查工作表是否存在\nFunction WorksheetExists(sheetName As String) As Boolean\n On Error Resume Next\n WorksheetExists = Not ThisWorkbook.Sheets(sheetName) Is Nothing\n On Error GoTo 0\nEnd Function\n\n' 辅助函数：按名称移除数据透视表\nSub RemovePivotTable(tableName As String)\n Dim ws As Worksheet\n Dim pt As PivotTable\n\n On Error Resume Next\n\n For Each ws In ThisWorkbook.Worksheets\n Set pt = ws.PivotTables(tableName)\n If Not pt Is Nothing Then\n pt.TableRange2.Clear\n Exit For\n End If\n Next ws\n\n On Error GoTo 0\nEnd Sub\n\n' 辅助函数：查找有数据的最后一行\nFunction FindLastRow(ws As Worksheet) As Long\n On Error Resume Next\n FindLastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row\n If FindLastRow = 1 And ws.Cells(1, 1).Value = "" Then FindLastRow = 0\n If Err.Number <> 0 Then FindLastRow = 0\n On Error GoTo 0\nEnd Function\n
​
代码功能总结
​
子程序A：主程序入口，依次调用B和Q子程序
​
子程序B：
​
1.
读取BOM（物料清单）数据并建立字典索引
​
​
2.
处理Focest数据，与BOM数据进行匹配计算
​
​
3.
生成包含物料用量和周数据的输出表
​
​
4.
记录未匹配的关键部件号到单独工作表
​
​
​
子程序Q：
​
1.
基于B子程序生成的输出表创建数据透视表
​
​
2.
按物料号汇总各周数据
​
​
3.
生成格式化的周汇总报告
​
​
​
辅助函数：提供性能优化、工作表检查、数据透视表管理等实用功能
​
1. Output工作表（详细计算结果）
​
数据结构：
​
A列：父料号
​
​
B列：LIC系数（需求放大系数）
​
​
C列：子料号
​
​
D列：BOM用量比例
​
​
E-BH列：56周的需求量计算（周1到周56）
​
​
​
使用场景：需要查看具体料号层级需求计算明细时使用
​
2. Cutput工作表（需求汇总透视表）
​
数据结构：
​
A列：料号
​
​
B列开始：各周需求总和
​
​
顶部标题：生成日期和时间戳
​
​
​
特点：
​
按料号汇总所有层级的需求
​
​
便于查看每个料件的总需求趋势
​
​
支持数据透视表分析
​
​
​
3. Unmatched工作表（异常检测）
​
内容：在Focest预测中出现但未在BOM中找到的料号清单
​
处理建议：
​
1.
检查BOM完整性
​
​
2.
确认料号编码是否正确
​
​
3.
更新BOM表数据
​
​
​
六、常见错误处理
​
错误类型症状根本原因解决方案
#REF!引用错误列索引超出数据范围检查B1:I1值是否在1-55范围内
#VALUE!值错误数值列中包含文本数据清理库存报表中的非数值字符
#N/A查找失败VLOOKUP未找到匹配料号验证料号在库存报表中存在
透视表不更新数据陈旧数据源范围未更新重新运行宏更新数据源
NT函数失效公式错误宏功能未启用保存为.xlsm格式并启用宏
​
​
"}