用于分析和评估与不同单元格中的数据相关的字符串的宏

Question

>我在 - A 列中有一个"数据代码"列表，B 列中的"条件"和"C 列"中的数值。我需要一个 VBA 代码来验证 B 列中与 A 列中的数据代码相关的条件，如果条件为真，则使用与 C 列相同的值更新 D 列，或者在 D 列中放入零并重复此过程，直到 A 列中的最后一个数据单元格。我遇到了VBA正则表达式，但我真的不知道如何使用它来解决问题？

任何帮助不胜感激！

例：- 单元格"A1" = "AAA BBB DDD EEE GGG HHH A11 B11 C11 1A1 1AB AA0"中的数据代码

细胞"B1" = "( AAA + BBB + ( CCC | DDD ) + ( EEE + ! FFF ) ) | ( GGG + HHH + DDD + EEE + FFF )"中的条件

单元格"C1" = "5"中的值

宏应更新单元格"D1" = "5"- 由于条件为真 - "A1"已AAA, BBB, DDD, EEE and "NOT FFF"

单元格"A2" = "AAA BBB DDD EEE GGG HHH A11 B11 C11 1A1 1AB AA0"中的数据代码 细胞"B1" = "( AAA + BBB + ( CCC | DDD ) + ( ! EEE + ! FFF ) ) | ( GGG + HHH + DDD + EEE + FFF )"中的条件 单元格"C2" = "3"中的值 宏应更新单元格"D2" = "0"，因为条件为假 - "A1"有"EEE"，没有"FFF"

Answer 1

欢迎来到 SO。谢谢并祝贺你提出了一个好问题。 可能还有其他解析方法可以将条件字符串转换为可行的公式，我选择了一个简单的解析方法，并以某种方式在 VBA 本身中使用公式。解决方案需要参考"Microsoft Visual Basic 以实现可扩展性"...要添加(在VBA项目窗口中->工具->参考->，然后添加)。

假定 B 列中的条件是一致的，并且所有运算符之间只有一个空格。但是，可以修改代码以对条件语法进行微小更改。工作表名称，行和列详细信息可根据实际需要进行修改。

测试的代码：

Option Explicit
Sub test3()
Dim TestStr As String
Dim CondStr As String, xFormula As String, iFormula As String
Dim Arr As Variant, VBstr As String
Dim i As Integer, Srw As Long, Lrw As Long, Rw As Long
Dim Ws As Worksheet, Wb As Workbook, Rslt As Boolean, vbc As VBComponent
Set Ws = ThisWorkbook.ActiveSheet
Set Wb = Workbooks.Add
Set vbc = Wb.VBProject.VBComponents.Add(vbext_ct_StdModule)
Srw = 1
Lrw = Ws.Cells(Rows.Count, 1).End(xlUp).Row
For Rw = Srw To Lrw
'TestStr = "AAA BBB DDD EEE GGG HHH A11 B11 C11 1A1 1AB AA0"
'TestStr = "AAA BBB EEE GGG HHH A11 B11 C11 1A1 1AB AA0"
TestStr = Ws.Cells(Rw, 1).Value
'CondStr = "( AAA + BBB + ( CCC | DDD ) + ( EEE + ! FFF ) ) | ( GGG + HHH + DDD + EEE + FFF )"
CondStr = Ws.Cells(Rw, 2).Value
Arr = Split(CondStr, " ")
VBstr = ""
For i = LBound(Arr) To UBound(Arr)
xFormula = Trim(Arr(i))
Select Case xFormula
Case ""
iFormula = ""
Case "(", ")"
iFormula = Arr(i)
Case "+"
iFormula = " And "
Case "|"
iFormula = " OR "
Case "!"
iFormula = " Not "
Case Else
iFormula = (InStr(1, TestStr, xFormula) > 0)
End Select
VBstr = VBstr & iFormula
Next i
VBstr = "X = " & VBstr
Debug.Print Rw & VBstr

Dim StrLine As Long, LineCnt As Long
With vbc.CodeModule
On Error Resume Next
StrLine = .ProcBodyLine("VersatileCode", vbext_pk_Proc)
LineCnt = .ProcCountLines("VersatileCode", vbext_pk_Proc)
.DeleteLines StrLine, LineCnt
On Error GoTo 0
.InsertLines StrLine + 1, "Sub VersatileCode()"
.InsertLines StrLine + 2, VBstr
.InsertLines StrLine + 3, "ThisWorkbook.Sheets(1).cells(1,1).value = X"
.InsertLines StrLine + 4, "End Sub"
End With
DoEvents
Application.Run Wb.Name & "!VersatileCode"
DoEvents
Rslt = Wb.Sheets(1).Cells(1, 1).Value
Debug.Print Rslt
If Rslt = True Then
Ws.Cells(Rw, 4).Value = Ws.Cells(Rw, 3).Value
Else
Ws.Cells(Rw, 4).Value = 0
End If
Next Rw
Wb.Close False
End Sub