问题评估＆amp;


Issue Evaluating & Iterating A Regex in Excel VBA

我的目标是将我正在工作的Python脚本逻辑转换为Excel VBA宏。由于我对vba不太熟悉，我对在Python中工作但在这里不工作的构造有一些问题。作为背景，我的python脚本读取一个word-doc，要求用户输入从包含regex片段的预编变量创建一个模式，在docx上执行regex并将这些结果返回到Excel单元格。以下代码是到目前为止我在Excel VBA中遇到的问题部分：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
patterninput = InputBox("a1 = Title" & vbNewLine &"a2 = First Name" & vbNewLine &"a3 = Last Name" & vbNewLine &"b = Address" & vbNewLine &"c = Town, State Zip" & vbNewLine &"x = Line Omit","Step #3: Enter Pattern")
            Dim x As String
            Dim a1 As String
            Dim a2 As String
            Dim a3 As String
            Dim b As String
            Dim c As String
            x ="(?:.+)\s+"
            a1 ="([\w\.]+)\s+"
            a2 ="(\w+)\s+"
            a3 ="(.+)[\s
]+"
            b ="(\d+\s.+)[\s
]+"
            c ="(.+)"
    pattern = keyword &"[\s
]+" & Application.Evaluate(patterninput)

    Dim objMatches As MatchCollection

    With regEx
        .Global = False
        .MultiLine = True
        .IgnoreCase = False
        .pattern = pattern
    End With

    Set objMatches = regEx.Execute(strInput)
    Dim row As Long
    Dim SubMatches As Variant
    row = .Rows.Count + 1
    For Each SubMatches In objMatches
        Cells(row, 1).Value = objMatches(0).SubMatches(0)
        Cells(row, 2).Value = objMatches(0).SubMatches(1)
        Cells(row, 3).Value = objMatches(0).SubMatches(2)
        Cells(row, 4).Value = objMatches(0).SubMatches(3)
        Cells(row, 5).Value = objMatches(0).SubMatches(4)
        row = row + 1
    Next

我的第一个问题是，我似乎无法评估PatternInput，比如eval()在python中的工作方式，从而引发错误。在为模式变量分配适当的代码片段时，是否有一种方法可以评估和连接用户输入的所有内容？

如果为了演示而忽略了这一部分并硬编码一个模式，我就会遇到第二个更重要的问题。我希望regex找到一个匹配项，然后将每个子匹配项放入同一行中的5个单独列中(我希望它从max行+1开始；基本上是第一个未写行)。完成后，我希望它移到下一个匹配项上，执行下一行相同的操作(因此行=行+1，因为vba显然不能执行行+1)。但是，按照目前的工作方式，它正确地执行前两列，然后将其余的文本(和可行的匹配项)放入第三列并完成。我需要它重复一遍，但我似乎不能让它工作。下面是我正在使用的演示文本，其中"sinessely"是关键字：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Dear Sir,

Hello

Sincerely,

Mr. Thomas Dahlmer
46 Alpine Street
Evanston, Il 60201

Dear Sir,

Hello

Sincerely,

Mr. Robert Thomas
1104 Madison Avenue
New York, NY 10021

任何帮助都将非常感谢，希望我能从中学习，并更好地熟悉Excel VBA。谢谢您！

相关讨论

你必须把你的信的正文输入我的str变量；我只是把样本文本放入a2(实际上，a2:a17合并)中进行演示。在这个站点上有很多关于将文本文件放入字符串变量的例子。

这使用instr和split来避免使用regex模式。tbph，我只是不太擅长多行，全球regex模式。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Option Explicit

Sub wqreqwq()
    Dim b As Long, e As Long
    Dim str As String, sal As String, con As String
    Dim info As Variant

    With Worksheets("sheet6")
        ReDim info(4)
        sal ="sincerely," & vbLf & vbLf
        str = Replace(.Cells(2,"A").Value2, vbCrLf, vbLf) & vbLf & vbLf

        b = InStr(1, str, sal, vbTextCompare)
        Do While CBool(b)
            b = b + Len(sal)
            e = InStr(b, str, vbLf & vbLf, vbTextCompare)
            'b = InStr(e + 2, str, sal, vbTextCompare)

            con = Mid(str, b, e - b)
            info = Split(con, vbLf)
            ReDim Preserve info(4)
            info(3) = Split(info(2), Chr(44) & Chr(32))(1)
            info(2) = Split(info(2), Chr(44) & Chr(32))(0)
            info(4) = Split(info(3), Chr(32))(1)
            info(3) = Split(info(3), Chr(32))(0)
            .Cells(.Rows.count,"C").End(xlUp).Offset(1, 0).Resize(1, 5) = info

            b = InStr(e, str, sal, vbTextCompare)
        Loop

    End With

End Sub

我把邮政编码留作一个看起来像数字的文本。通常，我将etxt转换为一个数字，并使用自定义的数字格式，如[>99999]00000-0000;00000;[red]@，它将zip s显示为真数字，同时允许zips和zip+4。任何拒绝成为真数字的值都以红色字体显示，让您了解失败的情况。

enter image description here

相关讨论