'=============================================================================
' 模块：货期检查主模块
' 功能：从[生产订单明细查询]提取数据到[货期检查]，并完成货期分析计算
'=============================================================================
Option Explicit

'-----------------------------------------------------------------------------
' 主入口函数
' 功能：协调各子模块完成完整的货期检查流程
'-----------------------------------------------------------------------------
Public Sub RunDeliveryCheck()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    On Error GoTo ErrorHandler

    ' 1. 提取生产订单数据到货期检查表
    Call ExtractOrderData

    ' 2. 调用分类器填充产品分类
    Call FillProductClassification

    ' 3. 计算货期相关字段
    Call CalculateDeliveryFields

    ' 4. 自动推算修正交货日期
    Call AutoCalculateRevisedDate

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    MsgBox "货期检查完成！", vbInformation

    Exit Sub

ErrorHandler:
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    MsgBox "运行出错：" & Err.Description, vbCritical
End Sub

'-----------------------------------------------------------------------------
' 子模块1：从同目录下的[生产订单明细查询.xlsx]提取数据到[货期检查]第4行起
' 提取字段：销售合同号,排产号,序号,产品名称,技术参数,型号,业务员,数量,签订日期,交货日期
' 注：第11列为“修正交货日期”，留空由用户填写
'-----------------------------------------------------------------------------
Private Sub ExtractOrderData()
    Dim srcFilePath As String ' 源文件路径
    Dim wbSrc As Workbook    ' 源工作簿
    Dim wsSrc As Worksheet   ' 源工作表
    Dim wsDst As Worksheet   ' 目标工作表
    Dim srcData As Variant   ' 源数据数组
    Dim dstData As Variant   ' 目标写入数组
    Dim colMap(1 To 10) As Long  ' ★ 目标10个字段在源表中的列索引

    ' ★ 目标字段名（前10列，增加销售合同号放在第1列）
    Dim targetFields(1 To 10) As String
    targetFields(1) = "销售合同号"
    targetFields(2) = "排产号"
    targetFields(3) = "序号"
    targetFields(4) = "产品名称"
    targetFields(5) = "技术参数"
    targetFields(6) = "型号"
    targetFields(7) = "业务员"
    targetFields(8) = "数量"
    targetFields(9) = "签订日期"
    targetFields(10) = "交货日期"

    srcFilePath = ThisWorkbook.Path & "\生产订单明细查询.xlsx"

    If Dir(srcFilePath) = "" Then
        MsgBox "找不到数据源文件，请检查该文件是否与当前表格在同一目录下：" & vbCrLf & srcFilePath, vbCritical
        Exit Sub
    End If

    Set wsDst = ThisWorkbook.Worksheets("货期检查")
    Set wbSrc = Workbooks.Open(Filename:=srcFilePath, ReadOnly:=True)

    On Error Resume Next
    Set wsSrc = wbSrc.Worksheets("生产订单明细查询")
    On Error GoTo 0

    If wsSrc Is Nothing Then
        MsgBox "在源文件中找不到工作表 [生产订单明细查询]！", vbCritical
        wbSrc.Close SaveChanges:=False
        Exit Sub
    End If

    Dim srcLastRow As Long
    Dim srcLastCol As Long
    srcLastRow = wsSrc.Cells(wsSrc.Rows.count, 1).End(xlUp).Row
    srcLastCol = wsSrc.Cells(1, wsSrc.Columns.count).End(xlToLeft).Column

    If srcLastRow < 2 Then
        MsgBox "[生产订单明细查询.xlsx] 中无数据行！", vbExclamation
        wbSrc.Close SaveChanges:=False
        Exit Sub
    End If

    srcData = wsSrc.Range(wsSrc.Cells(1, 1), wsSrc.Cells(srcLastRow, srcLastCol)).Value
    wbSrc.Close SaveChanges:=False

    Dim i As Long, j As Long
    For i = 1 To 10
        colMap(i) = 0
        For j = 1 To srcLastCol
            If Trim(CStr(srcData(1, j))) = targetFields(i) Then
                colMap(i) = j
                Exit For
            End If
        Next j
        If colMap(i) = 0 Then
            MsgBox "源表中找不到字段：" & targetFields(i), vbCritical
            Exit Sub
        End If
    Next i

    Dim dstLastRow As Long
    dstLastRow = wsDst.Cells(wsDst.Rows.count, 1).End(xlUp).Row
    If dstLastRow >= 4 Then
        wsDst.Rows("4:" & dstLastRow).ClearContents
    End If

    Dim dataRowCount As Long
    dataRowCount = srcLastRow - 1

    ' ★ 目标表总列数变为17列
    ReDim dstData(1 To dataRowCount, 1 To 17)

    Dim r As Long
    For r = 1 To dataRowCount
        Dim srcRow As Long
        srcRow = r + 1

        ' 写入前10个提取字段
        For i = 1 To 10
            dstData(r, i) = srcData(srcRow, colMap(i))
        Next i
    Next r

    ' 写入数据并取消自动换行
    wsDst.Range(wsDst.Cells(4, 1), wsDst.Cells(3 + dataRowCount, 17)).Value = dstData
    With wsDst.Range(wsDst.Cells(4, 1), wsDst.Cells(3 + dataRowCount, 17))
        .WrapText = False
        .Rows.AutoFit
    End With
End Sub

'-----------------------------------------------------------------------------
' 子模块2：调用GaugeClassifier对[货期检查]的"型号"列进行分类
' 结果写入"产品分类"列（现为第12列）
'-----------------------------------------------------------------------------
Private Sub FillProductClassification()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("货期检查")

    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.count, 1).End(xlUp).Row

    If lastRow < 4 Then Exit Sub

    ' ★ 读取型号列（插入字段后现为第6列）
    Dim modelArr As Variant
    modelArr = ws.Range(ws.Cells(4, 6), ws.Cells(lastRow, 6)).Value

    Dim rowCount As Long
    rowCount = lastRow - 3

    Dim classArr() As Variant
    ReDim classArr(1 To rowCount, 1 To 1)

    Dim classifier As New GaugeClassifier

    Dim r As Long
    For r = 1 To rowCount
        classArr(r, 1) = classifier.Classify(CStr(modelArr(r, 1)))
    Next r

    ' ★ 写入产品分类列（现为第12列）
    ws.Range(ws.Cells(4, 12), ws.Cells(lastRow, 12)).Value = classArr
End Sub

'-----------------------------------------------------------------------------
' 子模块3：计算所有货期相关字段
'   第13列 BIP货期（日历天）
'   第14列 BIP货期（工作日）
'   第15列 工厂货期（工作日）
'   第16列 BIP货期是否合理
'   第17列 差值
'-----------------------------------------------------------------------------
Private Sub CalculateDeliveryFields()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("货期检查")

    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.count, 1).End(xlUp).Row
    If lastRow < 4 Then Exit Sub

    Dim rowCount As Long
    rowCount = lastRow - 3

    Dim signDateArr  As Variant  ' 签订日期 (第9列)
    Dim delivDateArr As Variant  ' 交货日期 (第10列)
    Dim classArr     As Variant  ' 产品分类 (第12列)
    Dim qtyArr       As Variant  ' 数量 (第8列)

    ' ★ 修正读取数据的列索引
    signDateArr = ws.Range(ws.Cells(4, 9), ws.Cells(lastRow, 9)).Value
    delivDateArr = ws.Range(ws.Cells(4, 10), ws.Cells(lastRow, 10)).Value
    classArr = ws.Range(ws.Cells(4, 12), ws.Cells(lastRow, 12)).Value
    qtyArr = ws.Range(ws.Cells(4, 8), ws.Cells(lastRow, 8)).Value

    Dim holidays As Object
    Set holidays = LoadHolidays()

    Dim factoryLeadTable As Variant
    Dim factoryCategories() As String
    Dim factoryRanges() As String
    Call LoadFactoryLeadTable(factoryLeadTable, factoryCategories, factoryRanges)

    Dim outArr() As Variant
    ReDim outArr(1 To rowCount, 1 To 5)

    Dim r As Long
    For r = 1 To rowCount
        Dim signDate  As Date
        Dim delivDate As Date
        Dim category  As String
        Dim qty       As Long
        Dim bipCalendar As Long
        Dim bipWorkday  As Long
        Dim factoryWD   As Long

        If IsEmpty(signDateArr(r, 1)) Or IsEmpty(delivDateArr(r, 1)) Then
            GoTo NextRow
        End If

        signDate = CDate(signDateArr(r, 1))
        delivDate = CDate(delivDateArr(r, 1))
        category = CStr(classArr(r, 1))
        qty = CLng(qtyArr(r, 1))

        bipCalendar = DateDiff("d", signDate, delivDate)
        bipWorkday = CalcWorkdays(signDate, delivDate, holidays)
        factoryWD = LookupFactoryLead(category, qty, factoryLeadTable, factoryCategories, factoryRanges)

        Dim isReasonable As String
        If factoryWD <= bipWorkday Then
            isReasonable = "合理"
        Else
            isReasonable = "不合理"
        End If

        Dim diff As Long
        diff = bipWorkday - factoryWD

        outArr(r, 1) = bipCalendar
        outArr(r, 2) = bipWorkday
        outArr(r, 3) = factoryWD
        outArr(r, 4) = isReasonable
        outArr(r, 5) = diff

NextRow:
    Next r

    ' ★ 一次性写入第13-17列
    ws.Range(ws.Cells(4, 13), ws.Cells(lastRow, 17)).Value = outArr
End Sub

'-----------------------------------------------------------------------------
' 子模块4：自动推算修正交货日期（按排产号统一计算）
'-----------------------------------------------------------------------------
Private Sub AutoCalculateRevisedDate()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("货期检查")

    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.count, 1).End(xlUp).Row
    If lastRow < 4 Then Exit Sub

    Dim rowCount As Long
    rowCount = lastRow - 3

    Const N As Long = -3

    Dim holidays As Object
    Set holidays = LoadHolidays()

    ' ★ 读取所需列：排产号(2), 签订日期(9), 工厂货期_工作日(15), 差值(17)
    Dim pcNoArr As Variant, signDateArr As Variant, factoryWdArr As Variant, diffArr As Variant
    pcNoArr = ws.Range(ws.Cells(4, 2), ws.Cells(lastRow, 2)).Value
    signDateArr = ws.Range(ws.Cells(4, 9), ws.Cells(lastRow, 9)).Value
    factoryWdArr = ws.Range(ws.Cells(4, 15), ws.Cells(lastRow, 15)).Value
    diffArr = ws.Range(ws.Cells(4, 17), ws.Cells(lastRow, 17)).Value

    Dim dictNeedRevise As Object
    Dim dictMaxDate As Object
    Set dictNeedRevise = CreateObject("Scripting.Dictionary")
    Set dictMaxDate = CreateObject("Scripting.Dictionary")

    Dim r As Long
    Dim pcNo As String

    For r = 1 To rowCount
        pcNo = Trim(CStr(pcNoArr(r, 1)))
        If pcNo <> "" Then
            If Not dictNeedRevise.Exists(pcNo) Then
                dictNeedRevise.Add pcNo, False
                dictMaxDate.Add pcNo, CDate(0)
            End If

            If IsNumeric(diffArr(r, 1)) And Not IsEmpty(diffArr(r, 1)) Then
                If CLng(diffArr(r, 1)) <= N Then
                    dictNeedRevise(pcNo) = True
                End If
            End If

            If IsDate(signDateArr(r, 1)) And IsNumeric(factoryWdArr(r, 1)) Then
                Dim signDate As Date
                Dim factoryWD As Long
                Dim reqDate As Date

                signDate = CDate(signDateArr(r, 1))
                factoryWD = CLng(factoryWdArr(r, 1))
                reqDate = AddWorkdays(signDate, factoryWD, holidays)

                If reqDate > dictMaxDate(pcNo) Then
                    dictMaxDate(pcNo) = reqDate
                End If
            End If
        End If
    Next r

    Dim outArr() As Variant
    ReDim outArr(1 To rowCount, 1 To 1)

    For r = 1 To rowCount
        pcNo = Trim(CStr(pcNoArr(r, 1)))
        If pcNo <> "" Then
            If dictNeedRevise(pcNo) = True Then
                If dictMaxDate(pcNo) > CDate(0) Then
                    outArr(r, 1) = dictMaxDate(pcNo)
                Else
                    outArr(r, 1) = Empty
                End If
            Else
                outArr(r, 1) = Empty
            End If
        Else
            outArr(r, 1) = Empty
        End If
    Next r

    ' ★ 一次性写入第11列（修正交货日期）
    ws.Range(ws.Cells(4, 11), ws.Cells(lastRow, 11)).Value = outArr
End Sub

'-----------------------------------------------------------------------------
' 日期推算函数：在起始日期基础上往后加上指定的工作日数（自动跳过节假日）
'-----------------------------------------------------------------------------
Private Function AddWorkdays(startDate As Date, workDaysToAdd As Long, holidays As Object) As Date
    Dim currentDate As Date
    Dim addedDays As Long

    currentDate = startDate
    addedDays = 0

    ' 循环递增日期，直到累加的有效工作日达到工厂需要的天数
    While addedDays < workDaysToAdd
        currentDate = currentDate + 1
        Dim dk As Long
        dk = CLng(currentDate)

        ' 如果字典(日历表)中找不到这一天，说明不是休息日，计为一个工作日
        If Not holidays.Exists(dk) Then
            addedDays = addedDays + 1
        End If
    Wend

    AddWorkdays = currentDate
End Function

'=============================================================================
' 辅助函数区
'=============================================================================

'-----------------------------------------------------------------------------
' 从[日历]工作表加载节假日（是否休息=1/TRUE/"是"等）到Dictionary
' 返回：key=日期序列号(Long)，value=True
'-----------------------------------------------------------------------------
Private Function LoadHolidays() As Object
    Dim ws As Worksheet
    ' ★ 修复：Worksheet 对象赋值必须使用 Set
    Set ws = ThisWorkbook.Worksheets("日历")

    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.count, 1).End(xlUp).Row

    Dim dict As Object
    ' ★ 修复：CreateObject 返回对象，赋值必须使用 Set
    Set dict = CreateObject("Scripting.Dictionary")

    If lastRow < 2 Then
        Set LoadHolidays = dict
        Exit Function
    End If

    ' 读取全部数据（含表头）
    Dim data As Variant
    data = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, 2)).Value

    ' 找日期列和是否休息列
    Dim dateCol As Long, restCol As Long
    Dim c As Long
    For c = 1 To 2
        Select Case Trim(CStr(data(1, c)))
            Case "日期":     dateCol = c
            Case "是否休息": restCol = c
        End Select
    Next c

    If dateCol = 0 Or restCol = 0 Then
        MsgBox "[日历]工作表表头字段不符，请检查！", vbExclamation
        Set LoadHolidays = dict
        Exit Function
    End If

    Dim r As Long
    For r = 2 To lastRow
        If Not IsEmpty(data(r, dateCol)) Then
            Dim restVal As Variant
            restVal = data(r, restCol)
            ' 支持多种"休息"标记：TRUE, 1, "是", "1", "TRUE"
            Dim isRest As Boolean
            isRest = (restVal = True) Or (restVal = 1) Or _
                     (UCase(Trim(CStr(restVal))) = "是") Or _
                     (Trim(CStr(restVal)) = "1") Or _
                     (UCase(Trim(CStr(restVal))) = "TRUE")
            If isRest Then
                Dim dateKey As Long
                dateKey = CLng(CDate(data(r, dateCol)))
                If Not dict.Exists(dateKey) Then
                    dict.Add dateKey, True
                End If
            End If
        End If
    Next r

    Set LoadHolidays = dict
End Function

'-----------------------------------------------------------------------------
' 计算两个日期之间的工作日数（不含节假日）
' 说明：从startDate的次日到endDate，逐日判断是否为节假日
'       工作日 = 日历天 - 节假日天数
'-----------------------------------------------------------------------------
Private Function CalcWorkdays(startDate As Date, endDate As Date, holidays As Object) As Long
    Dim totalDays As Long
    Dim holidayCount As Long
    Dim d As Date

    totalDays = DateDiff("d", startDate, endDate)

    If totalDays <= 0 Then
        CalcWorkdays = 0
        Exit Function
    End If

    ' 遍历区间内每一天（不含startDate，含endDate）
    holidayCount = 0
    For d = startDate + 1 To endDate
        Dim dk As Long
        dk = CLng(d)
        If holidays.Exists(dk) Then
            holidayCount = holidayCount + 1
        End If
    Next d

    CalcWorkdays = totalDays - holidayCount
End Function

'-----------------------------------------------------------------------------
' 从[工厂货期]工作表加载货期查询表到二维数组
' 输出：
'   tableData      - 完整数据数组（不含表头行），行=产品分类，列=数量范围对应天数
'   categories()   - 产品分类名称数组（与tableData行对应）
'   rangeHeaders() - 数量范围表头字符串数组，如 "1-20","21-100","101-500"
'-----------------------------------------------------------------------------
Private Sub LoadFactoryLeadTable(ByRef tableData As Variant, _
                                  ByRef categories() As String, _
                                  ByRef rangeHeaders() As String)
    Dim ws As Worksheet
    ' ★ 修复：Worksheet 对象赋值必须使用 Set
    Set ws = ThisWorkbook.Worksheets("工厂货期")

    Dim lastRow As Long
    Dim lastCol As Long
    lastRow = ws.Cells(ws.Rows.count, 1).End(xlUp).Row
    lastCol = ws.Cells(1, ws.Columns.count).End(xlToLeft).Column

    If lastRow < 2 Or lastCol < 2 Then Exit Sub

    ' 读取全部数据含表头
    Dim raw As Variant
    raw = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol)).Value

    ' 解析表头：第1列为产品分类，后续列为数量范围
    Dim colCount As Long
    colCount = lastCol - 1  ' 排除产品分类列
    ReDim rangeHeaders(1 To colCount)
    Dim c As Long
    For c = 1 To colCount
        rangeHeaders(c) = Trim(CStr(raw(1, c + 1)))
    Next c

    ' 解析数据行
    Dim rowCount As Long
    rowCount = lastRow - 1
    ReDim categories(1 To rowCount)
    ReDim tableData(1 To rowCount, 1 To colCount)

    Dim r As Long
    For r = 1 To rowCount
        categories(r) = Trim(CStr(raw(r + 1, 1)))
        For c = 1 To colCount
            tableData(r, c) = raw(r + 1, c + 1)
        Next c
    Next r
End Sub

'-----------------------------------------------------------------------------
' 根据产品分类和数量查询工厂货期（工作日）
' 参数：
'   category       - 产品分类名称
'   qty            - 数量
'   tableData      - 货期数值二维数组
'   categories()   - 产品分类名称数组
'   rangeHeaders() - 数量范围表头数组，如"1-20"
' 返回：对应工厂货期天数，找不到返回0
'-----------------------------------------------------------------------------
Private Function LookupFactoryLead(category As String, qty As Long, _
                                    tableData As Variant, _
                                    categories() As String, _
                                    rangeHeaders() As String) As Long
    ' 找到对应的行（产品分类）
    Dim targetRow As Long
    targetRow = 0
    Dim r As Long
    For r = 1 To UBound(categories)
        If categories(r) = category Then
            targetRow = r
            Exit For
        End If
    Next r

    If targetRow = 0 Then
        LookupFactoryLead = 0
        Exit Function
    End If

    ' 找到对应的列（数量范围）
    Dim targetCol As Long
    targetCol = 0
    Dim c As Long
    For c = 1 To UBound(rangeHeaders)
        Dim lo As Long, hi As Long
        If ParseRange(rangeHeaders(c), lo, hi) Then
            If qty >= lo And qty <= hi Then
                targetCol = c
                Exit For
            End If
        End If
    Next c

    If targetCol = 0 Then
        ' 数量超出所有范围，取最后一列
        targetCol = UBound(rangeHeaders)
    End If

    LookupFactoryLead = CLng(tableData(targetRow, targetCol))
End Function

'-----------------------------------------------------------------------------
' 解析形如 "1-20", "21-100", "101-500" 的范围字符串
' 输出：lo（下限），hi（上限）
' 返回：True=解析成功，False=失败
'-----------------------------------------------------------------------------
Private Function ParseRange(rangeStr As String, ByRef lo As Long, ByRef hi As Long) As Boolean
    Dim parts() As String
    parts = Split(Trim(rangeStr), "-")
    If UBound(parts) = 1 Then
        On Error Resume Next
        lo = CLng(Trim(parts(0)))
        hi = CLng(Trim(parts(1)))
        On Error GoTo 0
        ParseRange = (lo > 0 And hi >= lo)
    Else
        ParseRange = False
    End If
End Function