AutoBOM/VBA_BOMConverter/Modules/M02_DataIO.bas

' ==============================================================================
' 模块: M02_DataIO
' 职责: 数据读写
' ==============================================================================
Option Explicit

Public Function ReadSourceData(ws As Worksheet) As Variant
    Dim lastRow As Long
    Dim i As Long, r As Long
    Dim arrRaw As Variant
    Dim arrResult() As Variant
    Dim cell As Range

    ' 查找C列最后一行（保持原有逻辑，使用代号列判断）
    lastRow = ws.Cells(ws.Rows.count, M04_Config.COL_IDX_CODE).End(xlUp).row

    If lastRow < M04_Config.SRC_START_ROW Then
        ReadSourceData = Empty
        Exit Function
    End If

    ' 第一步：使用数组方式读取整个数据区域（高性能）
    arrRaw = ws.Range(ws.Cells(M04_Config.SRC_START_ROW, 1), ws.Cells(lastRow, M04_Config.COL_IDX_CODE66)).Value

    ' 第二步：对66代码列（第9列）使用.Text属性重新读取，以保留前导0
    ' 因为.Value会将"00123"转换为123，而.Text会保留显示的"00123"
    ReDim arrResult(1 To UBound(arrRaw, 1), 1 To UBound(arrRaw, 2))

    ' 复制原始数据
    For r = 1 To UBound(arrRaw, 1)
        For i = 1 To UBound(arrRaw, 2)
            If i = M04_Config.COL_IDX_CODE66 Then
                ' 对于66代码列（I列），使用.Text属性读取显示文本
                Set cell = ws.Cells(M04_Config.SRC_START_ROW + r - 1, M04_Config.COL_IDX_CODE66)
                arrResult(r, i) = cell.Text
            Else
                ' 其他列使用原始值
                arrResult(r, i) = arrRaw(r, i)
            End If
        Next i
    Next r

    ReadSourceData = arrResult
End Function

Public Sub WriteCategoryToNewBook(catData As Object)
    Dim newWb As Workbook
    Dim ws As Worksheet
    Dim catName As Variant
    Dim colRows As Collection
    Dim finalArr() As Variant
    Dim headerKeys As Collection
    Dim i As Long, r As Long, c As Long
    Dim rowDict As Object
    Dim key As Variant

    If catData.count = 0 Then Exit Sub

    Set newWb = Workbooks.Add

    For Each catName In catData.keys
        Set colRows = catData(catName)

        If colRows.count > 0 Then
            ' 创建新Sheet
            Set ws = newWb.Worksheets.Add
            ws.Name = CleanSheetName(CStr(catName))

            ' 1. 扫描该类别所有Key
            Dim allKeysDict As Object
            Set allKeysDict = CreateObject("Scripting.Dictionary")

            For i = 1 To colRows.count
                ' colRows(i) 是一个 Array(Dict, BaseInfoArr)
                Set rowDict = colRows(i)(0)
                For Each key In rowDict.keys
                    If Not allKeysDict.Exists(key) Then allKeysDict.Add key, 0
                Next key
            Next i

            ' 2. 排序Key
            Dim sortedHeaders() As String
            sortedHeaders = SortHeaders(allKeysDict.keys)

            ' 3. 准备输出数组
            Dim condCount As Long
            condCount = UBound(sortedHeaders) - LBound(sortedHeaders) + 1
            ' 检查是否为空数组（如果全是无条件的物料）
            If sortedHeaders(0) = "" And condCount = 1 Then condCount = 0

            Dim totalCols As Long
            totalCols = condCount + 3 ' 条件列 + 名称/编码/数量

            ReDim finalArr(1 To colRows.count + 1, 1 To totalCols)

            ' 3.1 写表头
            Dim colOffset As Long
            colOffset = 0

            If condCount > 0 Then
                For c = 0 To condCount - 1
                    finalArr(1, c + 1) = sortedHeaders(c)
                Next c
                colOffset = condCount
            End If

            finalArr(1, colOffset + 1) = "名称"
            finalArr(1, colOffset + 2) = "编码"
            finalArr(1, colOffset + 3) = "数量"

            ' 3.2 填充内容
            For r = 1 To colRows.count
                Dim baseInfo As Variant
                Set rowDict = colRows(r)(0)
                baseInfo = colRows(r)(1) ' Array: Code, Name, Qty

                ' 填条件
                If condCount > 0 Then
                    For c = 0 To condCount - 1
                        key = sortedHeaders(c)
                        If rowDict.Exists(key) Then
                            finalArr(r + 1, c + 1) = rowDict(key)
                        End If
                    Next c
                End If

                ' 填基础信息
                finalArr(r + 1, colOffset + 1) = baseInfo(1) ' Name
                finalArr(r + 1, colOffset + 2) = baseInfo(0) ' Code
                finalArr(r + 1, colOffset + 3) = baseInfo(2) ' Qty
            Next r


            ' 4 设置编码列为文本格式（防止数字编码被转换为科学计数法或丢失前导零）
            ws.Columns(colOffset + 2).NumberFormat = "@"

            ' 4.1 写入Excel
            ws.Range("A1").Resize(UBound(finalArr, 1), UBound(finalArr, 2)).Value = finalArr
            ws.Range("A1").Resize(1, totalCols).Font.Bold = True

            ws.Columns.AutoFit
        End If
    Next catName

    MsgBox "处理完成！", vbInformation
End Sub

Private Function SortHeaders(keys As Variant) As String()
    ' 冒泡排序
    Dim i As Long, j As Long
    Dim temp As String
    Dim arr() As String
    Dim count As Long

    count = UBound(keys) - LBound(keys) + 1

    If count = 0 Then
        ReDim arr(0 To 0)
        arr(0) = ""
        SortHeaders = arr
        Exit Function
    End If

    ReDim arr(0 To count - 1)
    For i = 0 To count - 1
        arr(i) = keys(i)
    Next i

    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If M04_Config.GetHeaderPriority(arr(i)) > M04_Config.GetHeaderPriority(arr(j)) Then
                temp = arr(i)
                arr(i) = arr(j)
                arr(j) = temp
            End If
        Next j
    Next i

    SortHeaders = arr
End Function

Private Function CleanSheetName(s As String) As String
    Dim invalid As String, i As Long
    invalid = ":\/?*[]"
    CleanSheetName = s
    For i = 1 To Len(invalid)
        CleanSheetName = Replace(CleanSheetName, Mid(invalid, i, 1), "_")
    Next i
    If Len(CleanSheetName) > 31 Then CleanSheetName = Left(CleanSheetName, 31)
End Function