admin/ProductionCycleCheck
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add BLDI pressure gauge classification tool

Browse Source 
Implement VBA-based Excel tool for automatic classification of
pressure gauge model codes into 9 product categories.

Features:
- GaugeClassifier class with parsing and classification logic
- MainModule for Excel I/O with bulk array operations
- TestModule with comprehensive test suite (12 test cases)
- Complete documentation (README, INSTALL, algorithm guide)

Categories: 喷涂产品, 卫生型隔膜表, 隔膜表, 差压表,
膜盒压力表, 精密压力表, 电接点压力表, 常规表, 其他

Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
This commit is contained in:
Misaka_Company
2026-02-11 16:51:22 +08:00
commit 31a12fc9f5
8 changed files with 2014 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

168
VBA/ClassModules/GaugeClassifier.cls Normal file
View File

@@ -0,0 +1,168 @@
'=============================================================================
' GaugeClassifier - Core business logic class for pressure gauge classification
' Handles string parsing and classification based on priority decision funnel
'=============================================================================
Option Explicit
' Main classification entry point
' Input: modelString - Full model code string (e.g., "PYTH-100.A0.531|BP-088.2312|FBP-251040")
' Output: Classification name in Chinese
Public Function Classify(modelString As String) As String
Dim head As String
Dim flange As String
Dim mainModel As String
' Handle empty or invalid input
If Trim(modelString) = "" Then
Classify = "其他"
Exit Function
End If
' Extract components
head = GetHead(modelString)
flange = GetFlange(modelString)
mainModel = GetMainModel(head)
' Classification priority funnel (highest priority first)
' 1. 喷涂产品 (Spray-coated) - Highest Priority
' Check: Flange section ends with 'P' OR head contains 'F6AP' or 'F6BP'
If IsSprayProduct(flange, head) Then
Classify = "喷涂产品"
Exit Function
End If
' 2. 卫生型隔膜表 (Sanitary diaphragm)
' Check: Head contains 'F6A' or 'F6B' (excluding spray variants already caught)
If IsSanitary(head) Then
Classify = "卫生型隔膜表"
Exit Function
End If
' 3-8: Main model prefix based classification
Select Case True
' 3. 隔膜表 (Diaphragm)
Case mainModel Like "P*"
Classify = "隔膜表"
' 4. 差压表 (Differential pressure)
Case mainModel Like "YC*"
Classify = "差压表"
' 5. 膜盒压力表 (Capsule)
Case mainModel Like "YE*"
Classify = "膜盒压力表"
' 6. 精密压力表 (Precision)
Case mainModel Like "YB*"
Classify = "精密压力表"
' 7. 电接点压力表 (Electric contact)
Case mainModel Like "YX*"
Classify = "电接点压力表"
' 8. 常规表 (Regular)
Case mainModel Like "Y*"
Classify = "常规表"
' 9. 其他 (Other) - Default
Case Else
Classify = "其他"
End Select
End Function
'=============================================================================
' SPRAY PRODUCT DETECTION
'=============================================================================
Private Function IsSprayProduct(flange As String, head As String) As Boolean
' Check 1: Flange starts with F and 3rd character is P (e.g., FBP, FCP)
If flange <> "" And Len(flange) >= 3 Then
If Left(flange, 1) = "F" And Mid(flange, 3, 1) = "P" Then
IsSprayProduct = True
Exit Function
End If
End If
' Check 2: Head contains 'F6AP' or 'F6BP'
If InStr(head, "F6AP") > 0 Or InStr(head, "F6BP") > 0 Then
IsSprayProduct = True
Exit Function
End If
IsSprayProduct = False
End Function
'=============================================================================
' SANITARY DIAPHRAGM DETECTION
'=============================================================================
Private Function IsSanitary(head As String) As Boolean
' Contains 'F6A' or 'F6B' (but not spray variants)
' Note: Spray variants (F6AP, F6BP) are already caught by IsSprayProduct
If InStr(head, "F6A") > 0 Or InStr(head, "F6B") > 0 Then
IsSanitary = True
Else
IsSanitary = False
End If
End Function
'=============================================================================
' STRING PARSING METHODS
'=============================================================================
' Extract head section (everything before first '|')
' Example: "PYTH-100.A0.531|BP-088.2312|FBP-251040" -> "PYTH-100.A0.531"
Public Function GetHead(fullString As String) As String
Dim pipePos As Long
pipePos = InStr(fullString, "|")
If pipePos > 0 Then
GetHead = Left(fullString, pipePos - 1)
Else
' No pipe found, entire string is head
GetHead = fullString
End If
End Function
' Extract flange section (last section if starts with 'F')
' Example: "PYTH-100.A0.531|BP-088.2312|FBP-251040" -> "FBP-251040"
' Example: "PYTH-100.A0.531|BP-088.2312" -> ""
Public Function GetFlange(fullString As String) As String
Dim sections() As String
Dim lastSection As String
sections = Split(fullString, "|")
If UBound(sections) >= 0 Then
lastSection = Trim(sections(UBound(sections)))
' Check if last section starts with 'F' (flange indicator)
If Left(lastSection, 1) = "F" Then
GetFlange = lastSection
Else
GetFlange = ""
End If
Else
GetFlange = ""
End If
End Function
' Extract main model prefix from head (first word before '-')
' Example: "PYTH-100.A0.531.M201.M06" -> "PYTH"
' Example: "Y-040.Z0.200.M104.M07" -> "Y"
Public Function GetMainModel(headString As String) As String
Dim dashPos As Long
Dim model As String
' Find first dash
dashPos = InStr(headString, "-")
If dashPos > 0 Then
model = Left(headString, dashPos - 1)
Else
' No dash found, use entire head
model = headString
End If
GetMainModel = model
End Function

151
VBA/Modules/MainModule.bas Normal file
View File

@@ -0,0 +1,151 @@
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

201
VBA/Modules/TestModule.bas Normal file
View File

@@ -0,0 +1,201 @@
Option Explicit
'=============================================================================
' TestModule - Unit tests for GaugeClassifier
' Validates all classification logic against PRD test cases
'=============================================================================
' Main test runner - validates all test cases from PRD
Sub TestClassifierLogic()
Dim classifier As New GaugeClassifier
Dim testCases As Variant
Dim results As String
Dim passedCount As Long
Dim failedCount As Long
Dim i As Long
Dim actual As String
Dim expected As String
Dim passed As Boolean
' Initialize test suite (Input, Expected Output)
testCases = Array( _
Array("PYTH-100.A0.531.M201.M02|BP-088.2312.M02.0A3|FBP-251040.RF1.049.13.M20F.B.DPA", "喷涂产品"), _
Array("PYTH-063.A0.513.M05.U38.F6A.K15.1.1|BP-058.1509.M05.BB2.F6", "卫生型隔膜表"), _
Array("PYTH-063.A0.513.M05.U38.F6BP.K15.1.1|BP-058.1509.M05.BB2.F6", "喷涂产品"), _
Array("PYTH-063.A0.513.M201.M09|BP-058.1509.M09.0A2|FC-1520.RF1.033.1.M20F.B.DPA", "隔膜表"), _
Array("PYXHN-100.A0.531.M201.M09.H4|BP-088.2518.M09.0A3.YXH|F5.M42M.M20F.030.3.033.1.B", "隔膜表"), _
Array("YCSH-100.A0.531.M201.M07|BP-088.2312.M07.0A3.YCS", "差压表"), _
Array("YE-070.A0.204.G144.K21|BP-058.1509.K21.0A2", "膜盒压力表"), _
Array("YB-120.A0.407.Z144.M23|BP-110.5250.P60.0A5", "精密压力表"), _
Array("YX-100.A0.200.M204.M16.H4|BP-098.0088.M16.0A3.YX", "电接点压力表"), _
Array("Y-040.Z0.200.M104.M07|BP-037.1007.M07.0A2", "常规表"), _
Array("Y-100.BT.200.M204.M12|BP-098.0088.B17.PA3", "常规表"), _
Array("", "其他") _
)
passedCount = 0
failedCount = 0
results = "========================================" & vbCrLf
results = results & "GaugeClassifier Test Results" & vbCrLf
results = results & "========================================" & vbCrLf & vbCrLf
' Run all test cases
For i = LBound(testCases) To UBound(testCases)
expected = testCases(i)(1)
actual = classifier.Classify(CStr(testCases(i)(0)))
passed = (actual = expected)
If passed Then
passedCount = passedCount + 1
results = results & "[✓ PASS] Test " & (i + 1) & ": " & expected & vbCrLf
Else
failedCount = failedCount + 1
results = results & "[✗ FAIL] Test " & (i + 1) & vbCrLf
results = results & " Input: " & Left(CStr(testCases(i)(0)), 50) & "..." & vbCrLf
results = results & " Expected: " & expected & vbCrLf
results = results & " Actual: " & actual & vbCrLf & vbCrLf
End If
Next i
' Summary
results = results & "========================================" & vbCrLf
results = results & "Summary:" & vbCrLf
results = results & " Total: " & (passedCount + failedCount) & vbCrLf
results = results & " Passed: " & passedCount & vbCrLf
results = results & " Failed: " & failedCount & vbCrLf
results = results & "========================================"
' Output to Immediate Window
Debug.Print results
' Display message box
If failedCount = 0 Then
MsgBox "所有测试通过! (" & passedCount & "/" & (passedCount + failedCount) & ")", vbInformation, "测试成功"
Else
MsgBox "测试失败: " & failedCount & " 个失败" & vbCrLf & _
"详见立即窗口 (Ctrl+G)", vbExclamation, "测试失败"
End If
End Sub
' Test individual parsing methods
Sub TestParsingMethods()
Dim classifier As New GaugeClassifier
Dim testString As String
Dim head As String
Dim flange As String
Dim mainModel As String
Debug.Print "========================================"
Debug.Print "Parsing Method Tests"
Debug.Print "========================================"
' Test 1: Full model with flange
testString = "PYTH-100.A0.531.M201.M06|BP-088.2312.M06.0A3|FB-5020.RF3.049.1"
head = classifier.GetHead(testString)
flange = classifier.GetFlange(testString)
mainModel = classifier.GetMainModel(head)
Debug.Print "Test 1: Full model with flange"
Debug.Print " Input: " & testString
Debug.Print " Head: " & head
Debug.Print " Flange: " & flange
Debug.Print " MainModel: " & mainModel
Debug.Print ""
' Test 2: Model without flange
testString = "Y-040.Z0.200.M104.M07|BP-037.1007.M07.0A2"
head = classifier.GetHead(testString)
flange = classifier.GetFlange(testString)
mainModel = classifier.GetMainModel(head)
Debug.Print "Test 2: Model without flange"
Debug.Print " Input: " & testString
Debug.Print " Head: " & head
Debug.Print " Flange: " & flange
Debug.Print " MainModel: " & mainModel
Debug.Print ""
' Test 3: Single character main model
testString = "Y-100.BT.200.M204.M12|BP-098.0088.B17.PA3"
head = classifier.GetHead(testString)
flange = classifier.GetFlange(testString)
mainModel = classifier.GetMainModel(head)
Debug.Print "Test 3: Single character main model"
Debug.Print " Input: " & testString
Debug.Print " Head: " & head
Debug.Print " Flange: " & flange
Debug.Print " MainModel: " & mainModel
Debug.Print ""
' Test 4: Spray product with F6AP
testString = "PYTH-063.A0.513.M05.U38.F6AP.K15.1.1|BP-058.1509.M05.BB2.F6"
head = classifier.GetHead(testString)
flange = classifier.GetFlange(testString)
mainModel = classifier.GetMainModel(head)
Debug.Print "Test 4: Spray product with F6AP"
Debug.Print " Input: " & testString
Debug.Print " Head: " & head
Debug.Print " Flange: " & flange
Debug.Print " MainModel: " & mainModel
Debug.Print "========================================"
Debug.Print "Parsing tests complete. Check results above."
End Sub
' Performance test with large dataset
Sub TestPerformance()
Dim classifier As New GaugeClassifier
Dim testStrings() As String
Dim startTime As Double
Dim endTime As Double
Dim i As Long
Dim count As Long
count = 1000 ' Test with 1000 records
' Generate test data
ReDim testStrings(1 To count)
For i = 1 To count
testStrings(i) = "PYTH-100.A0.531.M201.M02|BP-088.2312.M02.0A3|FBP-251040.RF1.049.13.M20F.B.DPA"
Next i
' Measure performance
startTime = Timer
For i = 1 To count
classifier.Classify(testStrings(i))
Next i
endTime = Timer
Debug.Print "========================================"
Debug.Print "Performance Test"
Debug.Print "========================================"
Debug.Print "Records processed: " & count
Debug.Print "Time elapsed: " & Format(endTime - startTime, "0.000") & " seconds"
Debug.Print "Average per record: " & Format((endTime - startTime) / count, "0.0000") & " seconds"
Debug.Print "Records per second: " & Format(count / (endTime - startTime), "0")
Debug.Print "========================================"
MsgBox "性能测试完成!" & vbCrLf & _
"处理 " & count & " 条记录，耗时: " & Format(endTime - startTime, "0.000") & " 秒", _
vbInformation, "性能测试"
End Sub
' Interactive test - single input
Sub TestSingleInput()
Dim classifier As New GaugeClassifier
Dim inputStr As String
Dim result As String
inputStr = InputBox("请输入型号代码:", "单个型号测试")
If inputStr <> "" Then
result = classifier.Classify(inputStr)
Debug.Print "========================================"
Debug.Print "Single Input Test"
Debug.Print "========================================"
Debug.Print "Input: " & inputStr
Debug.Print "Output: " & result
Debug.Print "========================================"
MsgBox "型号: " & inputStr & vbCrLf & _
"分类: " & result, vbInformation, "测试结果"
End If
End Sub