Regex VBA使用正则表达式查找包含值范围的字符串，并替换为该范围内的每个值

首先，很抱歉标题太长。我只是不知道如何简明扼要地说。我正试图在VBA中这样做，因为普通的Excel不会剪切它

基本上，我有一个专栏。每个单元格可能包含以下格式的数据：

flat 10-14;Flat 18-19;unit 7-9;flat A-D;ABC;DEF;

我需要的是找到包含“-”的字符串，并尝试用介于两者之间的任何内容替换它。因此，上述代码将成为

Flat 10, Flat 11; Flat 12, Flat 14;Flat 18, Flat 19;Unit 7, Unit 8, Unit 9;Flat A, Flat B, Flat C; ABC;DEF;

在on RegExpression的帮助下，我成功地解决了如何用数字扩展数据位的问题，我将在下面发布代码。然而，我不知道用字母扩展数据的好方法。i、 e从

平面A-C

到

平面A、平面B、平面C

下面是我的代码，如果你认为它能更有效的话，请随时给我指点。我在这方面非常业余。先谢谢你

Sub CallRegEx()
    Dim r As Match
    Dim mcolResults As MatchCollection
    Dim strInput As String, strPattern As String
    Dim test As String, StrOutput As String, prefix As String
    Dim startno As Long, endno As Long
    Dim myrange As Range

    strPattern = "(Flat|Unit) [0-9]+-+[0-9]+"

With Worksheets("Sheet1")
    lrow = .Cells(Rows.Count, 9).End(xlUp).Row
    For Each x In .Range("A2:A" & lrow)
        strInput = Range("A" & x.Row).Value
        Set mcolResults = RegEx(strInput, strPattern, True, , True)
        If Not mcolResults Is Nothing Then

        StrOutput = strInput

        For Each r In mcolResults
                    startno = Mid(r, (InStr(r, "-") - 2), 2)
                    endno = Mid(r, (InStr(r, "-") + 1))
                    prefix = Mid(r, 1, 4)
                    test = ""
                        For i = startno To endno - 1
                        test = test & prefix & " " & i & ","
                        Next i
                        test = test & prefix & " " & endno
                    'this is because I don't want the comma at the end of the last value
                    StrOutput = Replace(StrOutput, r, test)

            Debug.Print r ' remove in production
        Next r
        End If
    .Range("D" & x.Row).Value = StrOutput
    Next x

End With
End Sub

下面的此功能用于支持上面的子功能

Function RegEx(strInput As String, strPattern As String, _
    Optional GlobalSearch As Boolean, Optional MultiLine As Boolean, _
    Optional IgnoreCase As Boolean) As MatchCollection

    Dim mcolResults As MatchCollection
    Dim objRegEx As New RegExp

    If strPattern <> vbNullString Then

        With objRegEx
            .Global = GlobalSearch
            .MultiLine = MultiLine
            .IgnoreCase = IgnoreCase
            .Pattern = strPattern
        End With

        If objRegEx.test(strInput) Then
            Set mcolResults = objRegEx.Execute(strInput)
            Set RegEx = mcolResults
        End If
    End If
End Function

函数RegEx（strInput作为字符串，strPattern作为字符串_
可选全局搜索为布尔值，可选多行搜索为布尔值_
可选IgnoreCase（作为布尔值）作为MatchCollection
Dim mcolResults作为匹配集合
Dim objRegEx作为新的RegExp
如果strPattern vbNullString，则
用objRegEx
.Global=GlobalSearch
.MultiLine=多行
.IgnoreCase=IgnoreCase
.Pattern=strPattern
以
如果是objRegEx.test（strInput），则
Set mcolResults=objRegEx.Execute（strInput）
设置RegEx=mcolResults
如果结束
如果结束
端函数

字母有顺序的字符代码（A

inputStr = "flat 10-14;Flat 18-19;unit 7-9;flat A-D;ABC;DEF;flat 6;flat T"

Dim re As RegExp: Set re = New RegExp
    re.Pattern = "(flat|unit)\s+((\d+)-(\d+)|([A-Z])-([A-Z]))"
    re.Global = True
    re.IgnoreCase = True

Dim m As MatchCollection
Dim start As Variant, fin As Variant
Dim tokens() As String
Dim i As Long, j As Long
Dim isDigit As Boolean

tokens = Split(inputStr, ";")

For i = 0 To UBound(tokens) '// loop over tokens

    Set m = re.Execute(tokens(i))

    If (m.Count) Then
        With m.Item(0)
            start = .SubMatches(2) '// first match number/letter
            isDigit = Not IsEmpty(start) '// is letter or number?

            If (isDigit) Then '// number
                fin = .SubMatches(3)
            Else '// letter captured as char code
                start = Asc(.SubMatches(4))
                fin = Asc(.SubMatches(5))
            End If

            tokens(i) = ""

            '// loop over items
            For j = start To fin
                 tokens(i) = tokens(i) & .SubMatches(0) & " " & IIf(isDigit, j, Chr$(j)) & ";"
            Next
        End With
    ElseIf i <> UBound(tokens) Then tokens(i) = tokens(i) & ";"
    End If
Next

Debug.Print Join(tokens, "")

inputStr=“平面10-14；平面18-19；单元7-9；平面A-D；ABC；DEF；平面6；平面T”
Dim re As RegExp:Set re=New RegExp
re.Pattern=“（平面单元）\s+（\d+）-（\d+）（[A-Z]）-（[A-Z]）”
re.Global=True
re.IgnoreCase=True
Dim作为MatchCollection
变光启动作为变型，鳍作为变型
Dim tokens（）作为字符串
我和我一样长，我和我一样长
Dim isDigit作为布尔值
标记=拆分（inputStr，“；”）
对于i=0到UBound（令牌）//loop-over-tokens
设置m=重新执行（令牌（i））
如果（m.Count）那么
带m.Item（0）
开始=.SubMatches（2）//第一个匹配号/字母
isDigit=Not IsEmpty（start）//是字母还是数字？
如果（isDigit），则“//编号
fin=.子匹配（3）
Else'//捕获为字符代码的字母
开始=Asc（.SubMatches（4））
fin=Asc（.子匹配（5））
如果结束
代币（i）=“”
“//在项目上循环
对于j=开始鳍
代币（i）=代币（i）和子匹配（0）和“&IIf（isDigit，j，Chr$（j））&
下一个
以
ElseIf i UBound（代币）然后代币（i）=代币（i）&“
如果结束
下一个
调试。打印联接（标记“”）

---

10号公寓；11号公寓；12号公寓；13号公寓；14号公寓；18号公寓；19号公寓；第七单元；第八单元；第九单元；平面A；单位B；平面C；平面D；ABC；DEF；6号公寓；扁T

---

谢谢你，亚历克斯，你明白我的意思。也谢谢你写了一个新的剧本，看起来好多了。但是，为了我的目的，我不能使用；作为新扩展文本中的分隔符，但这肯定是我可以处理的。