Question

首先，对不起，标题太长了。我只是不知道如何简洁。我试图在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;

借助RegExpression上的this article，我设法弄清楚了如何用数字扩展数据位，我将在下面的代码中发布。但是，我不知道用字母扩展数据的好方法。即从 Flat A-C 到 Flat A, Flat B, Flat 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

下面的功能是为了支持上面的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

Answer 1

字母具有顺序的字符代码（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, "")

单位10;单位11;单位12;单位13;单位14;单位18;单位19;单位7;单位8;单位9;单位A;单位B;单位C;单位D; ABC; DEF;单位6;平坦的T

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

1 个答案: