AutoBOM/VBA_BOMConverter/Modules/M02_DataIO.bas

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

Public Function ReadSourceData(ws As Worksheet) As Variant
    Dim lastRow As Long
    ' 查找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

    ' 读取整张表的数据区域 (假设列数不超过20列，足以覆盖到类别列)
    ReadSourceData = ws.Range(ws.Cells(M04_Config.SRC_START_ROW, 1), ws.Cells(lastRow, M04_Config.COL_IDX_CAT)).Value
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. 写入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