VBA Encuentra una cadena que tiene rango de valor en ella con expresiones regulares y reemplazar con cada valor en ese rango

votos
2

En primer lugar, lo siento por el largo título. Sólo que no sé cómo decirlo de manera sucinta. Estoy tratando de hacer esto en VBA Excel como normal no se corte.

Básicamente, tengo una columna. Cada células pueden contener datos en el formato de algo parecido

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

Lo que necesito es encontrar la cadena que tiene - en ella, y tratar de sustituirlo por cualquier otra cosa. por lo que el código anterior se convertirá en

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;

Con la ayuda de este artículo en RegExpression, he logrado encontrar la manera de ampliar los bits de datos con el número, que voy a publicar el código de abajo. Sin embargo, no sé una buena manera de ampliar los datos con la letra. es decir, de Flat A-CaFlat A, Flat B, Flat C

Mi código está por debajo, no dude en dar a los punteros si cree que puede ser más eficiente. Estoy muy aficionado a esto. Gracias de antemano.

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

Esta función es de abajo para apoyar la Sub anteriormente

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
Publicado el 27/11/2018 a las 16:59
fuente por usuario
En otros idiomas...                            


1 respuestas

votos
2

Las letras tienen códigos de caracteres que son ordinales (A <B <C ...) y estos se pueden acceder a través de ASC () / CHR $ () - aquí es una manera de hacerlo:

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, "")

plana 10; plana 11; plana 12; plana 13; plana 14; plana 18; plana 19; unidad 7; unidad 8; unidad 9; A plana; plana B; plana C; D plana; ABC; DEF; plana 6; plana T

Respondida el 27/11/2018 a las 18:07
fuente por usuario

Cookies help us deliver our services. By using our services, you agree to our use of cookies. Learn more