Attribute VB_Name = "工作表11"
Private Const ROW_RESIZE_COUNT As Long = 1000
Private Const OUTPUT_COL_START As Long = 3
Private Const OUTPUT_COL_END As Long = 25

Private Enum OutputMode
    OutputModePerson = 1
    OutputModeBS = 2
    OutputModeWS = 3
    OutputModeLS = 4
    OutputModeWP = 5
End Enum

' 目前模組內未使用，保留供未來擴充
Private Enum ValueMode
    ValueModeCount = 1
    ValueModeSum = 2
End Enum

' 輸出設定結構：集中管理各模式對應的欄位與索引
Private Type OutputConfig
    ClearRows As Variant          ' 要清除內容的列號陣列
    ClassRowMale As Long          ' 男生標籤列
    DataRowMale As Long           ' 男生資料列
    ClassRowFemale As Long        ' 女生標籤列
    DataRowFemale As Long         ' 女生資料列
    GenderIndex As Long           ' 分解 key 後，性別所在索引 (0-based)
    LabelIndex As Long            ' 分解 key 後，標籤所在索引 (0-based)
    SourceLabelCol As Long        ' 來源工作表中的標籤欄位
    SourceGenderCol As Long       ' 來源工作表中的性別欄位
End Type

Private Sub Worksheet_Activate()
    Me.Cells(1, 1).value = "Update " & Date

    Dim startTime As Double
    startTime = Timer

    Application.Calculation = xlManual
    Call XLS_init

    Call CalcClassCounts(OutputModePerson)
'    Call CalcClassCounts(OutputModeBS, 1)
'    Call CalcClassCounts(OutputModeWS, 2)
    ' Call CalcClassCounts(OutputModeLS, 3)
    ' Call CalcClassCounts(OutputModeWP, 4)

    Application.Calculation = xlAutomatic

    Me.Cells(6, 1).value = "執行時間：" & Format(Timer - startTime, "0.00") & " 秒"
End Sub

Public Sub CalcClassCounts(mode As Variant, Optional strField As Variant)
    ' strField 保留給未來小計欄位擴充使用
    Dim dictSubtotal As Object
    Set dictSubtotal = ProcessCustomerData(mode, strField)
    WriteOutputCommon dictSubtotal, mode
End Sub

Private Sub WriteOutputCommon(ByVal dataDict As Object, ByVal mode As OutputMode)
    Dim dataKey As Variant
    Dim dataValue As Variant
    Dim arrWords As Variant
    Dim cfg As OutputConfig
    Dim cellClass As Range
    Dim cellData As Range
    Dim classRow As Long
    Dim dataRow As Long
    Dim currentLabel As String
    Dim colIndex As Long
    Dim sortedKeys As Variant
    Dim i As Long

    On Error GoTo WriteOutputError

    If dataDict Is Nothing Or dataDict.count = 0 Then Exit Sub

    cfg = GetOutputConfig(mode)
    ClearOutputRows cfg.ClearRows

    colIndex = 2         ' 第一個標籤會變成 3，對應欄位 C
    currentLabel = vbNullString
    sortedKeys = SortKeys(dataDict.keys)

    For i = LBound(sortedKeys) To UBound(sortedKeys)
        dataKey = sortedKeys(i)
        arrWords = Split(dataKey, "_")
        dataValue = dataDict(dataKey)

        If UBound(arrWords) < 1 Then
            Debug.Print "警告: 數據格式錯誤: " & dataKey
            GoTo NextItem
        End If

        ' 標籤改變時換下一欄
        If CStr(arrWords(cfg.LabelIndex)) <> currentLabel Then
            colIndex = colIndex + 1
            currentLabel = CStr(arrWords(cfg.LabelIndex))
        End If

        If arrWords(cfg.GenderIndex) = "女" Then
            classRow = cfg.ClassRowFemale
            dataRow = cfg.DataRowFemale
        Else
            classRow = cfg.ClassRowMale
            dataRow = cfg.DataRowMale
        End If

        Set cellClass = Me.Cells(classRow, colIndex)
        Set cellData = Me.Cells(dataRow, colIndex)
        cellClass.value = arrWords(cfg.LabelIndex)
        cellData.value = dataValue

NextItem:
    Next i

    Exit Sub

WriteOutputError:
    MsgBox "寫入輸出時發生錯誤: " & Err.Description, vbExclamation, "寫入錯誤"
    Exit Sub
End Sub

Private Sub ClearOutputRows(ByVal rows As Variant)
    Dim idx As Long

    For idx = LBound(rows) To UBound(rows)
        Me.Range(Me.Cells(rows(idx), OUTPUT_COL_START), Me.Cells(rows(idx), OUTPUT_COL_END)).ClearContents
    Next idx
End Sub

Private Function GetOutputConfig(ByVal mode As OutputMode) As OutputConfig
    Dim cfg As OutputConfig

    Select Case mode
    Case OutputModePerson
        cfg.ClearRows = Array(2, 3, 4)
        cfg.ClassRowMale = 2
        cfg.DataRowMale = 3
        cfg.ClassRowFemale = 2
        cfg.DataRowFemale = 4
        cfg.GenderIndex = 1
        cfg.LabelIndex = 0
        cfg.SourceLabelCol = 4
        cfg.SourceGenderCol = 7
    Case OutputModeBS
        cfg.ClearRows = Array(9, 10, 11)
        cfg.ClassRowMale = 9
        cfg.DataRowMale = 10
        cfg.ClassRowFemale = 9
        cfg.DataRowFemale = 11
        cfg.GenderIndex = 1
        cfg.LabelIndex = 0
        cfg.SourceLabelCol = 12
        cfg.SourceGenderCol = 5
    Case OutputModeWS
        cfg.ClearRows = Array(16, 17, 18)
        cfg.ClassRowMale = 16
        cfg.DataRowMale = 17
        cfg.ClassRowFemale = 16
        cfg.DataRowFemale = 18
        cfg.GenderIndex = 1
        cfg.LabelIndex = 0
        cfg.SourceLabelCol = 13
        cfg.SourceGenderCol = 5
    Case OutputModeLS
        cfg.ClearRows = Array(33, 36, 38, 41)
        cfg.ClassRowMale = 33
        cfg.DataRowMale = 36
        cfg.ClassRowFemale = 38
        cfg.DataRowFemale = 41
        cfg.GenderIndex = 0
        cfg.LabelIndex = 1
        cfg.SourceLabelCol = 0   ' TODO: 請填入實際欄位
        cfg.SourceGenderCol = 0  ' TODO: 請填入實際欄位
    Case OutputModeWP
        cfg.ClearRows = Array(45, 48, 50, 53)
        cfg.ClassRowMale = 45
        cfg.DataRowMale = 48
        cfg.ClassRowFemale = 50
        cfg.DataRowFemale = 53
        cfg.GenderIndex = 0
        cfg.LabelIndex = 1
        cfg.SourceLabelCol = 0   ' TODO: 請填入實際欄位
        cfg.SourceGenderCol = 0  ' TODO: 請填入實際欄位
    Case Else
        Err.Raise vbObjectError + 1, "GetOutputConfig", "未知的輸出模式"
    End Select

    GetOutputConfig = cfg
End Function

Private Function ProcessCustomerData(mode As Variant, Optional strField As Variant) As Object
    Dim dict As Object
    Dim sourceRange As Variant
    Dim wsSource As Worksheet
    Dim i As Long
    Dim cfg As OutputConfig
    Dim labelValue As Variant
    Dim genderValue As Variant
    Dim dictKey As String

    Set dict = CreateObject("Scripting.Dictionary")
    Set wsSource = ActiveWorkbook.Worksheets("帳務")
    sourceRange = wsSource.Range("Cu帳務").Resize(ROW_RESIZE_COUNT)
    cfg = GetOutputConfig(mode)

    For i = 1 To UBound(sourceRange, 1)
        If Not IsEmpty(sourceRange(i, 1)) Then
            labelValue = sourceRange(i, cfg.SourceLabelCol)
            genderValue = sourceRange(i, cfg.SourceGenderCol)

            If cfg.LabelIndex = 0 Then
                dictKey = labelValue & "_" & genderValue
            Else
                dictKey = genderValue & "_" & labelValue
            End If

            SetDictionaryValue dict, dictKey, 1
        End If
    Next i

    Set ProcessCustomerData = dict
End Function

Private Sub SetDictionaryValue(ByRef dict As Object, ByVal key As Variant, ByVal value As Variant)
    If dict.Exists(key) Then
        dict(key) = dict(key) + value
    Else
        dict.Add key, value
    End If
End Sub

' 以氣泡排序法回傳排序後的 key 陣列，避免依賴外部 stdArray 函式庫
Private Function SortKeys(keys As Variant) As Variant
    Dim arr() As Variant
    Dim i As Long
    Dim j As Long
    Dim temp As Variant
    Dim n As Long

    n = UBound(keys) - LBound(keys) + 1
    If n <= 1 Then
        SortKeys = keys
        Exit Function
    End If

    ReDim arr(LBound(keys) To UBound(keys))
    For i = LBound(keys) To UBound(keys)
        arr(i) = keys(i)
    Next i

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

    SortKeys = arr
End Function