组合多个正则表达式模式 VBA
[英]combine multiple regex patterns VBA
问题描述
我使用下面的代码从 excel 单元格中提取大小，它有 7 种不同的模式。
以下代码用于提取 OZ 大小，但是，我需要执行相同的 ml 和 gram (g)。 因此，我编写代码的方式将非常冗长。
| 价值 | 结果 |
|---|---|
| 尺寸：0.028 盎司 x 5 | 0.028 盎司 x 5 |
| 尺寸：6x0.04 盎司 + 30 盎司 | 6 x0.04 盎司 |
| 尺寸：8 x 0.03 盎司 | 8 x 0.03 盎司 |
| 尺寸：2 x 0.07 盎司 | 2 x 0.07 盎司 |
| 尺寸：5 x 0.028 盎司 | 5 x 0.028 盎司 |
| 尺寸：0.028 ozx5 | 0.028 盎司x5 |
| 尺寸：0.028 盎司 | 0.028 盎司 |
| 尺寸：30.00 盎司 | 30.00 盎司 |
| 尺寸：2 * 0.07 盎司 | 2 * 0.07 盎司 |
| 尺寸：0.028 盎司 * 5 | 0.028 盎司 * 5 |
| 尺寸：2*0.07 盎司 | 2 *0.07 盎司 |
| 尺寸：0.028 盎司*5 | 0.028 盎司*5 |
| 尺寸：3.00 盎司 | 3.00 盎司 |
| 尺寸：3.00 盎司 | 3.00 盎司 |
| 颜色：01UNIVERSA#||#尺寸：1.00 oz | 1.00 盎司 |
| Lancôme Effacil 眼部卸妆液，4.2 Fl。 盎司。 | 0. 盎司 |
| 信心洁面乳，1 fl。 盎司，旅行装 | 1 层。 盎司 |
Function getozv1(str As String) Dim n As Long, unit As String, nums() As Variant Static rgx As Object, cmat As Object 'with rgx as static, it only has to be created once; beneficial when filling a long column with this UDF If rgx Is Nothing Then Set rgx = CreateObject("VBScript.RegExp") End If getsize = vbNullString cnt = 0 With rgx.Global = True.MultiLine = False.Pattern = "[0-9]{1,2}\sx\s[0-9.\-*?/]{1,5}\s*(fl oz|Fl oz|fl. oz|fl.oz|oz|Oz|oZ|OZ\s+)" 'for Size:2 x 0.5 oz If.test(str) Then Set cmat =.Execute(str) 'resize the nums array to accept the matches ReDim nums(cmat.Count - 1) 'get measurement unit unit = Replace(cmat.Item(0), Val(cmat.Item(0)), vbNullString, 1, vbTextCompare) 'populate the nums array with the matches For n = LBound(nums) To UBound(nums) nums(n) = Val(cmat.Item(n)) cnt = cnt + 1 Next n If cnt > 1 Then getozv1 = "Set" Else 'convert the nums array to a subtotal with unit suffix getozv1 = LCase(Application.Sum(nums) & " " & unit) End If End If If Not.test(str) Then.Pattern = "[0-9]{1,2}x[0-9.\-*?/]{1,5}\s*(fl oz|Fl oz|fl. oz|fl.oz|oz|Oz|oZ|OZ\s+)" ''for no space Size:2x0.5 oz If.test(str) Then Set cmat =.Execute(str) 'resize the nums array to accept the matches ReDim nums(cmat.Count - 1) 'get measurement unit unit = Replace(cmat.Item(0), Val(cmat.Item(0)), vbNullString, 1, vbTextCompare) 'populate the nums array with the matches For n = LBound(nums) To UBound(nums) nums(n) = Val(cmat.Item(n)) cnt = cnt + 1 Next n If cnt > 1 Then getozv1 = "Set" Else 'convert the nums array to a subtotal with unit suffix getozv1 = LCase(Application.Sum(nums) & " " & unit) End If End If End If If Not.test(str) Then.Pattern = "[0-9.\-*?/]{1,5}\s*(fl oz|Fl oz|fl. oz|fl.oz|oz|Oz|oZ|OZ\s+)\sx\s[0-9]{1,2}" 'for Size:0.028 oz x 5/ 0.8g 'pattern2 without space [0-9.\-*?/]{1,5}\s*(fl oz|Fl oz|fl. oz|fl.oz|oz|Oz|oZ|OZ\s+)x[0-9]{1,2} If.test(str) Then Set cmat =.Execute(str) 'resize the nums array to accept the matches ReDim nums(cmat.Count - 1) 'get measurement unit unit = Replace(cmat.Item(0), Val(cmat.Item(0)), vbNullString, 1, vbTextCompare) 'populate the nums array with the matches For n = LBound(nums) To UBound(nums) nums(n) = Val(cmat.Item(n)) cnt = cnt + 1 Next n If cnt > 1 Then getozv1 = "Set" Else 'convert the nums array to a subtotal with unit suffix getozv1 = LCase(Application.Sum(nums) & " " & unit) End If End If End If If Not.test(str) Then.Pattern = "[0-9.\-*?/]{1,5}\s*(fl oz|Fl oz|fl. oz|fl.oz|oz|Oz|oZ|OZ\s+)x[0-9]{1,2}" 'for without Size:0.028 oz x 5/ 0.8g If.test(str) Then Set cmat =.Execute(str) 'resize the nums array to accept the matches ReDim nums(cmat.Count - 1) 'get measurement unit unit = Replace(cmat.Item(0), Val(cmat.Item(0)), vbNullString, 1, vbTextCompare) 'populate the nums array with the matches For n = LBound(nums) To UBound(nums) nums(n) = Val(cmat.Item(n)) cnt = cnt + 1 Next n If cnt > 1 Then getozv1 = "Set" Else 'convert the nums array to a subtotal with unit suffix getozv1 = LCase(Application.Sum(nums) & " " & unit) End If End If End If If Not.test(str) Then.Pattern = "[0-9]{1,2}\s\*\s[0-9.\-*?/]{1,5}\s*(fl oz|Fl oz|fl. oz|fl.oz|oz|Oz|oZ|OZ\s+)" 'Size:2 * 0.07 oz If.test(str) Then Set cmat =.Execute(str) 'resize the nums array to accept the matches ReDim nums(cmat.Count - 1) 'get measurement unit unit = Replace(cmat.Item(0), Val(cmat.Item(0)), vbNullString, 1, vbTextCompare) 'populate the nums array with the matches For n = LBound(nums) To UBound(nums) nums(n) = Val(cmat.Item(n)) cnt = cnt + 1 Next n If cnt > 1 Then getozv1 = "Set" Else 'convert the nums array to a subtotal with unit suffix getozv1 = LCase(Application.Sum(nums) & " " & unit) End If End If End If If Not.test(str) Then.Pattern = "[0-9]{1,2}\*[0-9.\-*?/]{1,5}\s*(fl oz|Fl oz|fl. oz|fl.oz|oz|Oz|oZ|OZ\s+)" 'no space Size:2*0.07 oz If.test(str) Then Set cmat =.Execute(str) 'resize the nums array to accept the matches ReDim nums(cmat.Count - 1) 'get measurement unit unit = Replace(cmat.Item(0), Val(cmat.Item(0)), vbNullString, 1, vbTextCompare) 'populate the nums array with the matches For n = LBound(nums) To UBound(nums) nums(n) = Val(cmat.Item(n)) cnt = cnt + 1 Next n If cnt > 1 Then getozv1 = "Set" Else 'convert the nums array to a subtotal with unit suffix getozv1 = LCase(Application.Sum(nums) & " " & unit) End If End If End If If Not.test(str) Then.Pattern = "[0-9.\-*?/]{1,5}\s*(fl oz|Fl oz|fl. oz|fl.oz|oz|Oz|oZ|OZ\s+)\s\*\s[0-9]{1,2}" 'Size:0.028 oz * 5 If.test(str) Then Set cmat =.Execute(str) 'resize the nums array to accept the matches ReDim nums(cmat.Count - 1) 'get measurement unit unit = Replace(cmat.Item(0), Val(cmat.Item(0)), vbNullString, 1, vbTextCompare) 'populate the nums array with the matches For n = LBound(nums) To UBound(nums) nums(n) = Val(cmat.Item(n)) cnt = cnt + 1 Next n If cnt > 1 Then getozv1 = "Set" Else 'convert the nums array to a subtotal with unit suffix getozv1 = LCase(Application.Sum(nums) & " " & unit) End If End If End If If Not.test(str) Then.Pattern = "[0-9.\-*?/]{1,5}\s*(fl oz|Fl oz|fl. oz|fl.oz|oz|Oz|oZ|OZ\s+)\*[0-9]{1,2}" 'Size:0.028 oz*5 If.test(str) Then Set cmat =.Execute(str) 'resize the nums array to accept the matches ReDim nums(cmat.Count - 1) 'get measurement unit unit = Replace(cmat.Item(0), Val(cmat.Item(0)), vbNullString, 1, vbTextCompare) 'populate the nums array with the matches For n = LBound(nums) To UBound(nums) nums(n) = Val(cmat.Item(n)) cnt = cnt + 1 Next n If cnt > 1 Then getozv1 = "Set" Else 'convert the nums array to a subtotal with unit suffix getozv1 = LCase(Application.Sum(nums) & " " & unit) End If End If End If If Not.test(str) Then.Pattern = "([0-9.\-*?/]{1,5}\s*(fl oz|Fl oz|fl. oz|fl.oz|oz|Oz|oZ|OZ\s+)){1,3}" 'base pattern If.test(str) Then Set cmat =.Execute(str) 'resize the nums array to accept the matches ReDim nums(cmat.Count - 1) 'get measurement unit unit = Replace(cmat.Item(0), Val(cmat.Item(0)), vbNullString, 1, vbTextCompare) 'populate the nums array with the matches For n = LBound(nums) To UBound(nums) nums(n) = Val(cmat.Item(n)) cnt = cnt + 1 Next n If cnt > 1 Then getozv1 = "Set" Else 'convert the nums array to a subtotal with unit suffix getozv1 = LCase(Application.Sum(nums) & " " & unit) End If End If End If End With End Function
我们如何以有效的方式做到这一点？ 我们可以在不影响结果/准确性的情况下结合这 7 种模式吗？
还是有更好的方法来做到这一点？
克（克）毫升的几个例子
| 数据 | 预期结果 | 笔记 |
|---|---|---|
| MamaDerma 妊娠纹修复霜 - 100 ml | 100 毫升 | |
| MamaDerma 妊娠纹预防油 - 60 ml | 60 毫升 | |
| Supermood Egoboost 保湿精华，30ml | 30毫升 | |
| 大小：15 毫升 x3 | 15 毫升 x3 | |
| 尺寸：迷你尺寸 - 7 克 | 7 克 | |
| 类型： 4 克安瓿 40 克 Rubber™ 面膜，含保湿透明质酸 | 放 | 多种尺寸 |
| 尺码：标准尺码 - 5.0 g-金粉色 | 5.0克 | |
| 尺寸：迷你尺寸 - 7 克 | 7 克 | |
| 尺寸：标准尺寸 - 21 克 | 21 克 | |
| 尺寸：迷你尺寸半透明 - 5.4 g | 5.4 克 | |
| 05浅色/陶瓷白 7g | 7 克 | |
| 尺寸：28ml*4 | 28ml*4 | |
| 尺寸：20g*10 | 20克*10 | |
| 尺寸：（2ml+3ml）×4ml | 放 | 多种尺寸 |
| 尺寸4*18ml | 4*18ml | |
| 尺寸：27g*5ea | 27克*5 | |
| 尺寸 4.6ml × 4 | 4.6毫升×4 | |
| 尺寸 4 x 4.6 毫升 | 4×4.6毫升 | |
| 尺寸 4.6ml×4 | 4.6毫升×4 | |
| 尺寸 4x4.6ml | 4x4.6ml | |
| 尺寸：28ml*4 | 28ml*4 | |
| 尺寸：20g * 10 | 20克*10 | |
| 27mlx3片 | 27毫升x3 | |
| 尺寸：12 x 1.5g | 12×1.5克 | |
| 尺寸：12x1.5g | 12x1.5g |
2 个解决方案
解决方案1
1 已采纳 2021-04-02 11:35:27
开发适用于所有示例的单个正则表达式并不难。
我建议：
Option Explicit
'set reference to Microsoft VBcript Regular Expressions 5.5
Function getAmt(S As String) As String
Dim RE As RegExp, MC As MatchCollection
Const sPat As String = "(?:\d+\s*[x*]\s*)?\d+(?:\.\d+)?\s*(?=(g|ml|(?:fl)?\.?\s*oz))\1(?:\s*[×x*]\s*\d+)?"
Set RE = New RegExp
With RE
.Global = True
.IgnoreCase = True
.Pattern = sPat
Set MC = .Execute(S)
Select Case MC.Count
Case 0
getAmt = "no amount"
Case 1
getAmt = MC(0)
Case Is > 1
getAmt = "Set"
End Select
End With
End Function
它适用于您的所有示例（明显的拼写错误除外）
以下是正则表达式的详细说明：
从字符串中获取金额和数量
(?:\d+\s*[x*]\s*)?\d+(?:\.\d+)?\s*(?=(g|ml|(?:fl)?\.?\s*oz))\1(?:\s*[×x*]\s*\d+)?
选项：不区分大小写
- 匹配下面的正则表达式
(?:\d+\s*[x*]\s*)? - 匹配作为“数字”的单个字符
\d+ - 匹配下面的正则表达式
(?:\.\d+)? - 匹配作为“空白字符”的单个字符
\s* - 断言下面的正则表达式可以从这个 position 开始匹配（正前瞻）； 当回溯超出环视时，保持文本与嵌套捕获组匹配
(?=(g|ml|(?:fl)?\.?\s*oz))- 匹配下面的正则表达式并将其匹配捕获到反向引用编号 1
(g|ml|(?:fl)?\.?\s*oz)- 匹配这个备选
g - 或匹配此替代
ml- 从字面上匹配字符串“ml
ml
- 从字面上匹配字符串“ml
- 或者匹配这个替代
(?:fl)?\.?\s*oz
- 匹配这个备选
- 匹配下面的正则表达式并将其匹配捕获到反向引用编号 1
- 通过捕获组号 1
\1匹配最近匹配的相同文本 - 匹配下面的正则表达式
(?:\s*[×x*]\s*\d+)?- 在 0 到 1 次之间，尽可能多次，按需回馈（贪婪）
? - 匹配作为“空白字符”的单个字符
\s* - 匹配列表“×x*”
[×x*]中的单个字符 - 匹配作为“空白字符”的单个字符
\s* - 匹配作为“数字”的单个字符
\d+
- 在 0 到 1 次之间，尽可能多次，按需回馈（贪婪）
使用RegexBuddy创建
解决方案2
-1 2021-04-02 12:22:40
我想知道您为什么要将七个正则表达式合并为一个。 它可能会或可能不会更“有效”（您打算如何测试它？），它肯定会更难以维护。
我建议您做的第一件事是建立一个回归测试环境，这样您就可以确保您将来所做的任何更改都不会破坏现有的测试。 在 VBA 中，看起来像这样。
Option Explicit
Sub TestParse()
' Two dimensional array containing the test values and the expected results
Dim testdata(1 To 25, 1 To 2) As String
Dim i As Integer
Dim result As String
testdata(1, 1) = "MamaDerma Stretch Mark Repair Cream - 100 ml"
testdata(1, 2) = "100 ml"
testdata(2, 1) = "MamaDerma Stretch Mark Repair Cream - 60 ml"
testdata(2, 2) = "60 ml"
'add more values & expected results
testdata(25, 1) = "Size: 12x1.5g"
testdata(25, 2) = "12x1.5g"
' Test all values
For i = LBound(testdata, 1) To UBound(testdata, 1)
result = Parse(testdata(i, 1))
Debug.Print testdata(i), result, IIf(testdata(i, 2) = result, "PASS", "FAIL")
Next i
End Sub
' Function to parse values
Function Parse(ByVal toParse As String) As String
' Code to parse values goes here
End Function
分隔符 in Excel VBA Regex Patterns, filter something but not others
[英]Delimiters in Excel VBA Regex Patterns, filter something but not others
声明:本站的技术帖子网页，遵循CC BY-SA 4.0协议，如果您需要转载，请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.