refactor: rename VBA directory to VBA_BOMConverter
All checks were successful
NTFY Notification / notify (push) Successful in 20s
All checks were successful
NTFY Notification / notify (push) Successful in 20s
Rename VBA/ directory to VBA_BOMConverter/ for better clarity. This change reflects the module's purpose as the BOM converter component. Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
This commit is contained in:
Misaka_Company
289
VBA_BOMConverter/Modules/M03_Logic.bas
Normal file
289
VBA_BOMConverter/Modules/M03_Logic.bas
Normal file
@@ -0,0 +1,289 @@
|
||||
' ==============================================================================
|
||||
' 模块: M03_Logic
|
||||
' 职责: 核心算法。使用后期绑定(Late Binding)避免引用错误。
|
||||
' ==============================================================================
|
||||
Option Explicit
|
||||
|
||||
Private g_Logger As clsErrorLogger
|
||||
|
||||
' 初始化日志引用
|
||||
Public Sub InitLogic(logger As clsErrorLogger)
|
||||
Set g_Logger = logger
|
||||
End Sub
|
||||
|
||||
' ------------------------------------------------------------------------------
|
||||
' 主入口: 解析规则字符串
|
||||
' 返回: Collection (包含多个 Dictionary 对象)
|
||||
' ------------------------------------------------------------------------------
|
||||
Public Function ParseRule(strRule As String, rowIdx As Long) As Collection
|
||||
On Error GoTo ErrorHandler
|
||||
|
||||
Dim cleanStr As String
|
||||
cleanStr = CleanString(strRule)
|
||||
|
||||
' 空条件处理
|
||||
If Len(cleanStr) = 0 Then
|
||||
Dim col As New Collection
|
||||
' 创建一个空字典
|
||||
col.Add CreateObject("Scripting.Dictionary")
|
||||
Set ParseRule = col
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Set ParseRule = RecursiveParse(cleanStr, rowIdx)
|
||||
Exit Function
|
||||
|
||||
ErrorHandler:
|
||||
g_Logger.Record rowIdx, "M03.ParseRule", "System Error", Err.Description, strRule
|
||||
Set ParseRule = Nothing
|
||||
End Function
|
||||
|
||||
' ------------------------------------------------------------------------------
|
||||
' 递归解析核心
|
||||
' ------------------------------------------------------------------------------
|
||||
Private Function RecursiveParse(strExpr As String, rowIdx As Long) As Collection
|
||||
Dim splitIdx As Long
|
||||
|
||||
' 1. 查找顶层 OR (最低优先级，先拆分)
|
||||
splitIdx = FindSplitIndex(strExpr, "OR")
|
||||
If splitIdx > 0 Then
|
||||
Dim leftRes As Collection, rightRes As Collection
|
||||
' 递归左边
|
||||
Set leftRes = RecursiveParse(Trim(Left(strExpr, splitIdx - 1)), rowIdx)
|
||||
' 递归右边 (+2 是 OR 的长度)
|
||||
Set rightRes = RecursiveParse(Trim(Mid(strExpr, splitIdx + 2)), rowIdx)
|
||||
' 合并结果 (Union)
|
||||
Set RecursiveParse = UnionCollections(leftRes, rightRes)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' 2. 查找顶层 AND
|
||||
splitIdx = FindSplitIndex(strExpr, "AND")
|
||||
If splitIdx > 0 Then
|
||||
Dim leftCol As Collection, rightCol As Collection
|
||||
' 递归左边
|
||||
Set leftCol = RecursiveParse(Trim(Left(strExpr, splitIdx - 1)), rowIdx)
|
||||
' 递归右边 (+3 是 AND 的长度)
|
||||
Set rightCol = RecursiveParse(Trim(Mid(strExpr, splitIdx + 3)), rowIdx)
|
||||
' 笛卡尔积 (Intersection/Merge)
|
||||
Set RecursiveParse = CartesianProduct(leftCol, rightCol, rowIdx)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' 3. 去除外层括号
|
||||
If Left(strExpr, 1) = "(" And Right(strExpr, 1) = ")" Then
|
||||
' 防止像 (A) AND (B) 这种情况被误去括号，但这里已经被 FindSplitIndex 过滤了顶层操作符，
|
||||
' 所以如果这里首尾是括号，且中间没有暴露的操作符，说明是包裹的整体，例如 ((A AND B))
|
||||
Set RecursiveParse = RecursiveParse(Mid(strExpr, 2, Len(strExpr) - 2), rowIdx)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' 4. 原子解析 (Base Case)
|
||||
Set RecursiveParse = ParseAtom(strExpr, rowIdx)
|
||||
|
||||
End Function
|
||||
|
||||
' ------------------------------------------------------------------------------
|
||||
' 原子解析: key=val 或 key!=val
|
||||
' ------------------------------------------------------------------------------
|
||||
Private Function ParseAtom(strAtom As String, rowIdx As Long) As Collection
|
||||
Dim dict As Object ' Late Binding
|
||||
Set dict = CreateObject("Scripting.Dictionary")
|
||||
|
||||
Dim p As Long
|
||||
Dim key As String, val As String
|
||||
|
||||
' 移除多余空格，但保留值中间可能存在的(虽然通常没有)
|
||||
strAtom = Trim(strAtom)
|
||||
|
||||
If InStr(strAtom, "!=") > 0 Then
|
||||
p = InStr(strAtom, "!=")
|
||||
key = Trim(Left(strAtom, p - 1))
|
||||
val = Trim(Mid(strAtom, p + 2))
|
||||
dict.Add key, "!=" & val
|
||||
ElseIf InStr(strAtom, "=") > 0 Then
|
||||
p = InStr(strAtom, "=")
|
||||
key = Trim(Left(strAtom, p - 1))
|
||||
val = Trim(Mid(strAtom, p + 1))
|
||||
dict.Add key, val
|
||||
Else
|
||||
' 无法解析的格式
|
||||
If Len(strAtom) > 0 Then
|
||||
g_Logger.Record rowIdx, "M03.ParseAtom", "Syntax Error", "No = or != found", strAtom
|
||||
End If
|
||||
End If
|
||||
|
||||
Dim col As New Collection
|
||||
col.Add dict
|
||||
Set ParseAtom = col
|
||||
End Function
|
||||
|
||||
' ------------------------------------------------------------------------------
|
||||
' 笛卡尔积: AND 逻辑
|
||||
' ------------------------------------------------------------------------------
|
||||
Private Function CartesianProduct(col1 As Collection, col2 As Collection, rowIdx As Long) As Collection
|
||||
Dim res As New Collection
|
||||
Dim d1 As Object, d2 As Object
|
||||
Dim merged As Object
|
||||
Dim i As Long, j As Long
|
||||
|
||||
If col1 Is Nothing Or col2 Is Nothing Then
|
||||
Set CartesianProduct = Nothing
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
For i = 1 To col1.count
|
||||
For j = 1 To col2.count
|
||||
Set d1 = col1(i)
|
||||
Set d2 = col2(j)
|
||||
Set merged = MergeDictionaries(d1, d2, rowIdx)
|
||||
If Not merged Is Nothing Then
|
||||
res.Add merged
|
||||
End If
|
||||
Next j
|
||||
Next i
|
||||
|
||||
Set CartesianProduct = res
|
||||
End Function
|
||||
|
||||
' ------------------------------------------------------------------------------
|
||||
' 集合合并: OR 逻辑
|
||||
' ------------------------------------------------------------------------------
|
||||
Private Function UnionCollections(col1 As Collection, col2 As Collection) As Collection
|
||||
Dim res As New Collection
|
||||
Dim item As Variant
|
||||
|
||||
If Not col1 Is Nothing Then
|
||||
For Each item In col1
|
||||
res.Add item
|
||||
Next item
|
||||
End If
|
||||
|
||||
If Not col2 Is Nothing Then
|
||||
For Each item In col2
|
||||
res.Add item
|
||||
Next item
|
||||
End If
|
||||
|
||||
Set UnionCollections = res
|
||||
End Function
|
||||
|
||||
' ------------------------------------------------------------------------------
|
||||
' 字典合并 (处理冲突和 !=)
|
||||
' ------------------------------------------------------------------------------
|
||||
Private Function MergeDictionaries(d1 As Object, d2 As Object, rowIdx As Long) As Object
|
||||
Dim res As Object
|
||||
Set res = CreateObject("Scripting.Dictionary")
|
||||
|
||||
Dim k As Variant
|
||||
Dim v1 As String, v2 As String
|
||||
|
||||
' 复制 d1
|
||||
For Each k In d1.keys
|
||||
res.Add k, d1(k)
|
||||
Next k
|
||||
|
||||
' 合并 d2
|
||||
For Each k In d2.keys
|
||||
If res.Exists(k) Then
|
||||
v1 = CStr(res(k))
|
||||
v2 = CStr(d2(k))
|
||||
|
||||
If v1 = v2 Then
|
||||
' 相同，无视
|
||||
ElseIf Left(v1, 2) = "!=" And Left(v2, 2) = "!=" Then
|
||||
' 都是不等于，合并
|
||||
res(k) = v1 & "," & v2
|
||||
ElseIf Left(v1, 2) = "!=" And Left(v2, 2) <> "!=" Then
|
||||
' v1!=, v2=
|
||||
If v2 = Mid(v1, 3) Then
|
||||
g_Logger.Record rowIdx, "M03.Conflict", "Logic Conflict", "Equals disallowed value", k & ": " & v1 & " AND " & v2
|
||||
Set MergeDictionaries = Nothing: Exit Function
|
||||
Else
|
||||
res(k) = v2
|
||||
End If
|
||||
ElseIf Left(v1, 2) <> "!=" And Left(v2, 2) = "!=" Then
|
||||
' v1=, v2!=
|
||||
If v1 = Mid(v2, 3) Then
|
||||
g_Logger.Record rowIdx, "M03.Conflict", "Logic Conflict", "Equals disallowed value", k & ": " & v1 & " AND " & v2
|
||||
Set MergeDictionaries = Nothing: Exit Function
|
||||
Else
|
||||
res(k) = v1
|
||||
End If
|
||||
Else
|
||||
' 都是等于，但值不同
|
||||
g_Logger.Record rowIdx, "M03.Conflict", "Logic Conflict", "Mutually Exclusive", k & "=" & v1 & " AND " & v2
|
||||
Set MergeDictionaries = Nothing: Exit Function
|
||||
End If
|
||||
Else
|
||||
res.Add k, d2(k)
|
||||
End If
|
||||
Next k
|
||||
|
||||
Set MergeDictionaries = res
|
||||
End Function
|
||||
|
||||
' ------------------------------------------------------------------------------
|
||||
' 查找逻辑分割点 (忽略括号内容)
|
||||
' ------------------------------------------------------------------------------
|
||||
Private Function FindSplitIndex(strExpr As String, delimiter As String) As Long
|
||||
Dim i As Long
|
||||
Dim bracketLevel As Long
|
||||
Dim subStr As String
|
||||
Dim lenDelim As Long
|
||||
Dim checkStr As String
|
||||
|
||||
bracketLevel = 0
|
||||
lenDelim = Len(delimiter)
|
||||
|
||||
' 预处理：为了防止匹配到变量名里的字符，我们检查 " AND " (带空格)
|
||||
' 或者简单起见，我们假设变量名不包含 AND/OR 且大小写敏感
|
||||
' 这里采用严格括号计数
|
||||
|
||||
For i = 1 To Len(strExpr) - lenDelim + 1
|
||||
subStr = Mid(strExpr, i, 1)
|
||||
|
||||
If subStr = "(" Then
|
||||
bracketLevel = bracketLevel + 1
|
||||
ElseIf subStr = ")" Then
|
||||
bracketLevel = bracketLevel - 1
|
||||
ElseIf bracketLevel = 0 Then
|
||||
' 只有在第0层括号时才匹配逻辑符
|
||||
checkStr = Mid(strExpr, i, lenDelim)
|
||||
|
||||
' 关键修正：确保匹配的是独立单词，而不是变量名的一部分
|
||||
' 简单判断：前后字符是空格，或者处于字符串边界
|
||||
If UCase(checkStr) = delimiter Then
|
||||
Dim isWord As Boolean
|
||||
isWord = True
|
||||
|
||||
' 检查前一个字符
|
||||
If i > 1 Then
|
||||
If Mid(strExpr, i - 1, 1) <> " " And Mid(strExpr, i - 1, 1) <> ")" Then isWord = False
|
||||
End If
|
||||
|
||||
' 检查后一个字符
|
||||
If i + lenDelim <= Len(strExpr) Then
|
||||
If Mid(strExpr, i + lenDelim, 1) <> " " And Mid(strExpr, i + lenDelim, 1) <> "(" Then isWord = False
|
||||
End If
|
||||
|
||||
If isWord Then
|
||||
FindSplitIndex = i
|
||||
Exit Function
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Next i
|
||||
|
||||
FindSplitIndex = 0
|
||||
End Function
|
||||
|
||||
Private Function CleanString(s As String) As String
|
||||
' 移除多余的空格，将换行符替换为空格
|
||||
Dim temp As String
|
||||
temp = Replace(s, vbCrLf, " ")
|
||||
temp = Replace(temp, vbCr, " ")
|
||||
temp = Replace(temp, vbLf, " ")
|
||||
temp = Trim(temp)
|
||||
CleanString = temp
|
||||
End Function
|
||||
Reference in New Issue
Block a user