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