ProductionCycleCheck/VBA/Modules/Module_UpdateSource.bas

'-----------------------------------------------------------------------------
' 主过程：创建副本并更新数据
'-----------------------------------------------------------------------------
Public Sub UpdateSourceDataCopy()
    Dim wsCheck As Worksheet
    Dim lastRowCheck As Long, r As Long
    Dim pcNo As String, seqNo As String, revDate As Variant

    ' 使用字典存储需要修改的数据，键为 "排产号|序号"
    Dim updateDict As Object
    Set updateDict = CreateObject("Scripting.Dictionary")

    ' ==========================================
    ' 1. 读取 [货期检查] 中需要修改的数据
    ' ==========================================
    Set wsCheck = ThisWorkbook.Worksheets("货期检查")
    lastRowCheck = wsCheck.Cells(wsCheck.Rows.count, 1).End(xlUp).Row

    If lastRowCheck < 4 Then
        MsgBox "没有数据！", vbExclamation
        Exit Sub
    End If

    ' 遍历收集修正交货日期不为空的数据
    For r = 4 To lastRowCheck
        ' ★ 修正：第11列为修正交货日期
        revDate = wsCheck.Cells(r, 11).Value

        If Trim(CStr(revDate)) <> "" And IsDate(revDate) Then
            ' ★ 修正：排产号现为第2列，序号现为第3列
            pcNo = Trim(CStr(wsCheck.Cells(r, 2).Value))
            seqNo = Trim(CStr(wsCheck.Cells(r, 3).Value))

            If pcNo <> "" And seqNo <> "" Then
                ' 组合排产号和序号作为唯一主键
                updateDict(pcNo & "|" & seqNo) = Format(CDate(revDate), "yyyy-mm-dd")
            End If
        End If
    Next r

    ' 如果字典为空，说明没有需要修改的记录
    If updateDict.count = 0 Then
        MsgBox "未发现填有【修正交货日期】的有效数据，无需生成副本和修改。", vbInformation
        Exit Sub
    End If

    ' ==========================================
    ' 2. 复制原始文件，生成带时间戳的副本
    ' ==========================================
    Dim srcPath As String, copyPath As String
    Dim timeStamp As String

    srcPath = ThisWorkbook.Path & "\生产订单明细查询.xlsx"
    If Dir(srcPath) = "" Then
        MsgBox "找不到源文件：" & srcPath, vbCritical
        Exit Sub
    End If

    ' 生成精确到秒的时间戳，例如: 20260302_143005
    timeStamp = Format(Now, "yyyymmdd_hhmmss")
    copyPath = ThisWorkbook.Path & "\生产订单明细查询_" & timeStamp & ".xlsx"

    ' 复制文件
    On Error Resume Next
    FileCopy srcPath, copyPath
    If Err.Number <> 0 Then
        MsgBox "创建副本文件失败！请检查源文件是否正被其他程序打开占用。" & vbCrLf & Err.Description, vbCritical
        On Error GoTo 0
        Exit Sub
    End If
    On Error GoTo 0

    ' ==========================================
    ' 3. 打开副本文件并修改对应的交货日期
    ' ==========================================
    Dim wbCopy As Workbook
    Dim wsCopy As Worksheet
    Dim lastRowCopy As Long, lastColCopy As Long
    Dim colPcNo As Long, colSeqNo As Long, colDate As Long
    Dim i As Long
    Dim headerVal As String
    Dim modifiedCount As Long

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False ' 屏蔽可能出现的保存提示

    On Error GoTo ErrorHandler

    ' 后台打开刚刚生成的副本文件
    Set wbCopy = Workbooks.Open(Filename:=copyPath)
    Set wsCopy = wbCopy.Worksheets("生产订单明细查询")

    lastRowCopy = wsCopy.Cells(wsCopy.Rows.count, 1).End(xlUp).Row
    lastColCopy = wsCopy.Cells(1, wsCopy.Columns.count).End(xlToLeft).Column

    ' 动态查找副本文件中目标字段的列号 (防止数据源列顺序变动)
    For i = 1 To lastColCopy
        headerVal = Trim(CStr(wsCopy.Cells(1, i).Value))
        Select Case headerVal
            Case "排产号": colPcNo = i
            Case "序号": colSeqNo = i
            Case "交货日期": colDate = i
        End Select
    Next i

    ' 校验必要字段是否都找到了
    If colPcNo = 0 Or colSeqNo = 0 Or colDate = 0 Then
        MsgBox "在副本文件中找不到【排产号】、【序号】或【交货日期】列，修改失败！", vbCritical
        wbCopy.Close SaveChanges:=False
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        Exit Sub
    End If

    modifiedCount = 0

    ' 遍历副本文件的数据行（第1行是表头，从第2行开始）
    For r = 2 To lastRowCopy
        pcNo = Trim(CStr(wsCopy.Cells(r, colPcNo).Value))
        seqNo = Trim(CStr(wsCopy.Cells(r, colSeqNo).Value))

        If pcNo <> "" And seqNo <> "" Then
            ' 如果当前订单项存在于我们需要修改的字典中
            If updateDict.Exists(pcNo & "|" & seqNo) Then
                ' 将原来的交货日期替换为字典里存的修正交货日期
                wsCopy.Cells(r, colDate).Value = updateDict(pcNo & "|" & seqNo)
                modifiedCount = modifiedCount + 1
            End If
        End If
    Next r

    ' 保存并关闭副本文件
    wbCopy.Close SaveChanges:=True

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    MsgBox "副本数据修改成功！" & vbCrLf & vbCrLf & _
           "已生成新文件：生产订单明细查询_" & timeStamp & ".xlsx" & vbCrLf & _
           "共精准替换了 " & modifiedCount & " 条订单的交货日期。", vbInformation

    Exit Sub

ErrorHandler:
    Dim errDesc As String
    errDesc = Err.Description

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    On Error Resume Next
    If Not wbCopy Is Nothing Then wbCopy.Close SaveChanges:=False
    On Error GoTo 0

    MsgBox "修改副本文件时发生错误：" & vbCrLf & errDesc, vbCritical
End Sub