Отделяйте слова от цифр с помощью VBA - PullRequest
2 голосов
/ 11 марта 2020

У меня есть список адресов, которые мне нужно убрать.

Цель состоит в том, чтобы добавить пробел перед цифрами, как показано в примерах ниже.

16AVCHARLESDAGAULLECS10525             16 Avcharlesdagaullecs 10525
1BDHIPPOLYTEMARQUES                    1 Bdhippolytemarques
20GARRICKSTREET4THFLOOR                20 Garrickstreet 4Thfloor
2109ZAC                                2109 Zac
2-4VANDRIESSTREET4                     2-4 Vandriesstreet 4
5:ETVÄRG.19.E                          5:Etvärg. 19.E
901ACEHIGHENTTOWE9TH233                901 Acehighenttowe 9Th 233

Я нашел скрипт, который ставит пробелы между буквами, но это не моя цель. Вот код, который у меня есть. Это не дает результата выше.

Function Add_Spaces(ByVal sText As String) As String
   Dim CharNum As Long
   Dim FixedText As String
   Dim CharCode As Long

   FixedText = Left(sText, 1)

   For CharNum = 2 To Len(sText)
      CharCode = Asc(Mid(sText, CharNum, 1))
      If CharCode >= 65 And CharCode <= 90 Then
         FixedText = FixedText & " " & Mid(sText, CharNum, 1) 'This needs to be rewritten
      Else
         FixedText = FixedText & Mid(sText, CharNum, 1)
      End If
   Next CharNum

   Add_Spaces = FixedText
End Function

У вас есть идеи о том, как я могу решить эту проблему?

Вот решение для регулярного выражения, которое может дать отведение: R отделяет слова от чисел в строке

Ответы [ 5 ]

6 голосов
/ 11 марта 2020

Похоже, что это работает на всех ваших примерах:

Регулярное выражение разделяет переход от числа к букве и наоборот, а также делает исключение для TH и .

Эти исключения могут привести к проблемам в других данных, но, похоже, работают для того, что вы представляете. Является ли ваша изменчивость такой, что это будет проблемой, неизвестно.

Обратите внимание, что я использовал раннее связывание для Regex (инструменты / ссылки, включающие регулярные выражения Microsoft VBScript 5.5), но вы можете изменить это на поздняя привязка, если вы будете распространять этот код.

Редактировать: Обратите внимание, что я НЕ преобразовал это в надлежащий регистр, но это можно было бы сделать, если действительно требуется

`Set Reference to Microsoft VBScript Regular Expressions 5.5
Option Explicit
Function replacer(s As String) As String
    Dim RE As RegExp
    Const sPat As String = "(\dTH|\d)(?!TH)(?=[A-Z])|([A-Z.])(?=\d)"
    Const sRepl As String = "$1$2 "
    Dim sTemp As String
Set RE = New RegExp
With RE
    .Global = True
    .Pattern = sPat
    .IgnoreCase = True
    replacer = .Replace(s, sRepl)
End With

End Function

Формула будет, например:

A2: =replacer(A2)

Если требуется регистр PROPER, измените формулу на:

A2: =PROPER(replacer(A2))

this Здесь, в США, похоже, лучше работает с вашими данными, чем с функцией VBA StrConv.

enter image description here

2 голосов
/ 11 марта 2020

Несомненно, Regex - намного более аккуратный способ сделать это - но если вы хотите изменить существующий код для достижения желаемого результата, я думаю, что это может сработать:

Function Add_Spaces(ByVal sText As String) As String
    Dim CharNum As Long
    Dim FixedText As String
    Dim CharCode As Long
    Dim lastCharCode As Long

    FixedText = Left(sText, 1)

    For CharNum = 2 To Len(sText)
        CharCode = Asc(Mid(sText, CharNum, 1))
        lastCharCode = Asc(Mid(sText, CharNum - 1, 1))
         If (CharCode >= 65) <> (lastCharCode >= 65) Then
            FixedText = FixedText & " " & Mid(sText, CharNum, 1) 'This needs to be rewritten
        Else
            FixedText = FixedText & Mid(sText, CharNum, 1)
        End If
    Next CharNum

    Add_Spaces = Application.WorksheetFunction.Proper(FixedText)

End Function
2 голосов
/ 11 марта 2020

Попробуйте использовать две замены регулярных выражений для следующих шаблонов:

([A-Za-z])([0-9])
([0-9])([A-Za-z])

и замените на $1 $2:

Dim Regex As System.Text.RegularExpressions.Regex
Dim input As String = "16AVCHARLESDAGAULLECS10525"
Dim output As String = Regex.Replace(input, "([A-Za-z])([0-9])", "$1 $2")
output = Regex.Replace(output, "([0-9])([A-Za-z])", "$1 $2")
Console.WriteLine(output)

Это печатает:

16 AVCHARLESDAGAULLECS 10525

Стратегия здесь состоит в том, чтобы сопоставлять каждые два пограничных символа в отдельных группах захвата. Граница здесь - это число, за которым следует буква, или наоборот. Затем мы заменяем этими двумя захваченными символами пробел, вставленный между ними.

1 голос
/ 11 марта 2020

Эта функция также будет работать на всех примерах. Это также позволяет избежать разбиения в случае 'TH' после числа:

Private Function SeparateNumbersFromString(x As String) As String
  Dim i As Long, j As Long, strInt As String, strFin As String

   For i = 1 To Len(x)
        strInt = ""
        If IsNumeric(Mid(x, i, 1)) Then
            For j = i To Len(x)
                strInt = strInt & Mid(x, j, 1)
                If Not IsNumeric(strInt) Or (Right(strInt, 1) = "-" And _
                            IsNumeric(left(strInt, Len(strInt) - 1))) Or _
                            (Right(strInt, 1) = "." And _
                               IsNumeric(left(strInt, Len(strInt) - 1))) Then
                    strFin = IIf(strFin = "", strFin, strFin & " ") & _
                                  left(strInt, Len(strInt) - 1) & _
                                   IIf(UCase(Mid(x, j, 2)) = "TH", "", " ")
                    strInt = ""
                    i = j - 1
                    Exit For
                End If
                If j >= Len(x) Then strFin = strFin & " " & strInt: GoTo Ending
            Next j
        Else
            strFin = strFin & Mid(x, i, 1)
        End If
   Next i
Ending:
   SeparateNumbersFromString = strFin
End Function
1 голос
/ 11 марта 2020

Рассмотрим:

Public Function OutString(Instring As String) As String
    Dim L As Long, i As Long, CH As String

    L = Len(Instring)
    OutString = Left(Instring, 1)

    For i = 2 To L
        CH = Mid(Instring, i, 1)
        If CH Like "[0-9]" And Not Right(OutString, 1) Like "[0-9]" Then
            OutString = OutString & " " & CH
        Else
            OutString = OutString & CH
        End If
    Next i
End Function

enter image description here

Код подобен ползанию по строке с указателем. Если символ справа от указателя является цифрой, а символ слева от указателя не является цифрой, вставьте пробел.

...