VBA Найти строку с диапазоном значений в ней с помощью регулярного выражения и заменить ее каждым значением в этом диапазоне - PullRequest
Новая
       18

VBA Найти строку с диапазоном значений в ней с помощью регулярного выражения и заменить ее каждым значением в этом диапазоне

0 голосов
/ 27 ноября 2018

Прежде всего, простите за длинный заголовок.Я просто не знаю, как выразиться кратко.Я пытаюсь сделать это в 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 мне удалось выяснить, как расширить биты данных числом, которое я опубликуюкод ниже.Тем не менее, я не знаю хорошего способа дополнить данные буквой.то есть от 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

Эта функция ниже предназначена для поддержки саба выше 

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

1 Ответ

0 голосов
/ 27 ноября 2018

Буквы имеют порядковые коды символов (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; плоский 19; блок 7; блок 8; блок 9; плоский A; плоский B; плоский C; плоский D;ABC; DEF; плоский 6; плоский T

...