' ============================================================================
' 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 即可一键刷新所有数据
' ============================================================================