ProductionCycleCheck/VBA/Modules/MainModule.bas

Option Explicit

'=============================================================================
' MainModule - Excel interaction layer for Gauge Classification Tool
' Handles reading model codes from worksheet and writing classifications
'=============================================================================

' Main entry point - Run classification on selected range
' Reads model codes from column A, outputs classifications to column B
Sub RunClassification()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim dataRange As Range
    Dim inputData As Variant
    Dim outputData() As String
    Dim classifier As New GaugeClassifier
    Dim startTime As Double
    Dim endTime As Double
    Dim i As Long
    Dim rowCount As Long

    ' Start timing
    startTime = Timer

    ' Set reference to active worksheet
    Set ws = ActiveSheet

    ' Find last row in column A
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' Validate data exists
    If lastRow < 2 Then
        MsgBox "No data found starting from A2. Please enter model codes in column A.", vbExclamation, "No Data"
        Exit Sub
    End If

    ' Set range (A2 to last row)
    Set dataRange = ws.Range("A2:A" & lastRow)

    ' Bulk read data into memory array for performance
    inputData = dataRange.Value2
    rowCount = UBound(inputData, 1)

    ' Prepare output array
    ReDim outputData(1 To rowCount, 1 To 1)

    ' Process each row
    For i = 1 To rowCount
        If Not IsEmpty(inputData(i, 1)) Then
            ' Classify the model code
            outputData(i, 1) = classifier.Classify(CStr(inputData(i, 1)))
        Else
            outputData(i, 1) = "其他"
        End If
    Next i

    ' Bulk write output to column B
    ws.Range("B2:B" & (lastRow)).Value = outputData

    ' Add header
    ws.Range("B1").Value = "产品分类"

    ' Calculate elapsed time
    endTime = Timer

    ' Display completion message
    MsgBox "分类完成!" & vbCrLf & _
           "处理行数: " & rowCount & vbCrLf & _
           "耗时: " & Format(endTime - startTime, "0.000") & " 秒", _
           vbInformation, "完成"
End Sub

' Alternative: Run classification on selected cells only
Sub RunClassificationOnSelection()
    Dim selectedRange As Range
    Dim inputData As Variant
    Dim outputData() As String
    Dim classifier As New GaugeClassifier
    Dim startTime As Double
    Dim endTime As Double
    Dim i As Long
    Dim rowCount As Long
    Dim outputRange As Range

    ' Check if selection is valid
    If TypeName(Selection) <> "Range" Then
        MsgBox "请选择包含型号代码的单元格区域.", vbExclamation, "无效选择"
        Exit Sub
    End If

    Set selectedRange = Selection

    ' Validate single column selection
    If selectedRange.Columns.Count > 1 Then
        MsgBox "请只选择一列数据.", vbExclamation, "无效选择"
        Exit Sub
    End If

    ' Start timing
    startTime = Timer

    ' Bulk read data
    inputData = selectedRange.Value2
    rowCount = UBound(inputData, 1)

    ' Prepare output array
    ReDim outputData(1 To rowCount, 1 To 1)

    ' Process each row
    For i = 1 To rowCount
        If Not IsEmpty(inputData(i, 1)) Then
            outputData(i, 1) = classifier.Classify(CStr(inputData(i, 1)))
        Else
            outputData(i, 1) = "其他"
        End If
    Next i

    ' Write to adjacent column
    Set outputRange = selectedRange.Offset(0, 1)
    outputRange.Value = outputData

    ' Add header if first row is selected
    If selectedRange.Row = 1 Then
        outputRange.Cells(1, 1).Value = "产品分类"
    End If

    ' Calculate elapsed time
    endTime = Timer

    ' Display completion message
    MsgBox "分类完成!" & vbCrLf & _
           "处理行数: " & rowCount & vbCrLf & _
           "耗时: " & Format(endTime - startTime, "0.000") & " 秒", _
           vbInformation, "完成"
End Sub

' Clear classifications from column B
Sub ClearClassifications()
    Dim ws As Worksheet
    Dim lastRow As Long

    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

    If lastRow >= 2 Then
        ws.Range("B2:B" & lastRow).ClearContents
        MsgBox "分类结果已清除.", vbInformation, "清除完成"
    Else
        MsgBox "没有可清除的分类结果.", vbInformation, "提示"
    End If
End Sub