Пытаясь улучшить качество и эффективность моего кода VBA

Question

У меня есть 50000 строк имен и адресов, каждая из которых занимает одну ячейку. Чтобы разделить ячейку на другое имя, номер улицы, улицу, город и т. Д. Я пытаюсь разбить ячейки на столбцы, которые соответствуют либо номеру улицы, либо названию улицы.

• Примеры ячеек все в столбце E:

  ряд строк: E

  1. Aparts. 56 Johnston Terrace Keyham Road
  2. 90 & 92 Wolseley Road
  3. 2 Эйнсли Террас
  4. Dyer & Cleaner 10 & 12 Mount Gold Road
  5. 48b Александер Роуд
  6. Молочный фермер Stratham Priory Road

• Результат NewCell в столбцах;

  Row. Col.F | Полковник | Col.H

  1. Aparts. | 56 | Johnston Terrace Keyham Road
  2. '*' | 90 и 92 | Wolseley Road
  3. '*' | 2 | Ainslie Terrace
  4. Dyer & Cleaner | 10 и 12 | Гора Золотая Дорога
  5. '*' | 48б | Александровская дорога
  6. Молочный Фермер | '*' | Stratham Priory Road

В настоящее время мой лист Excel не имеет конкретных имен столбцов, только A; B; C и т. Д. У меня есть код VBA, который будет разделять каждую ячейку. Однако номер улицы и / или название улицы будут разделяться по-разному в зависимости от строки «textnumbertext» в каждой ячейке.
У меня есть отдельный код VBA, чтобы добавить звездочку перед любой записью, которая начинается с номера улицы (см. Код). Это затем помещает каждую ячейку в правильный столбец (я могу удалить звездочку позже). Однако я чувствую, что этот код неэффективен и, возможно, мог бы быть менее многословным, если бы я использовал функцию Case.

Еще одним осложнением является то, что некоторые номера улиц будут 14А, или 12В, или 10с, или 12а. Если я добавлю эти опции в приведенный ниже код, то все станет очень длинным и неэффективным. Есть мысли, пожалуйста?

Sub ReplaceFirstNumber()
'If the first character in the string starts with a number between 1-9 THEN 
'ADD a * to the string
Dim r As Range
Dim c As Range
On Error Resume Next
Set r = Range(Range("E1"), Range("E" & Rows.Count).End(xlDown))
    For Each c In r
     If Left(c.Value, 1) = "1" _
     Or Left(c.Value, 1) = "2" _
     Or Left(c.Value, 1) = "3" _
     Or Left(c.Value, 1) = "4" _
     Or Left(c.Value, 1) = "5" _
     Or Left(c.Value, 1) = "6" _
     Or Left(c.Value, 1) = "7" _
     Or Left(c.Value, 1) = "8" _
     Or Left(c.Value, 1) = "9" Then
     c.Value = " * " & c.Value
    End If
   Next c
End Sub

Answer 1

Мне любопытно, как вы будете все кодировать, но по поводу вашего вопроса, что-то, что может сработать, будет:

Sub ReplaceFirstNumber()
'If the first character in the string starts with a number between 1-9 THEN 
'ADD a * to the string
Dim r As Range
Dim c As Range
Set r = Range("E1:E" & Range("E" & Rows.Count).End(xlUp).Row)
    For Each c In r
     If IsNumeric(Left(c.Value, 1))=True Then c.Value = "*" & c.Value
   Next c
End Sub

В вашем коде вы используете Range(Range("E1"), Range("E" & Rows.Count).End(xlDown)). Это означает все ячейки в столбце E! . И это похоже на миллион ячеек в Excel 2007 или выше. В моем коде диапазон равен Set r = Range("E1:E" & Range("E" & Rows.Count).End(xlUp).Row) Это будет выбирать только все ячейки между E1 и последней непустой ячейкой в ​​столбце E, поэтому будет улучшено время выполнения много , если у вас всего 50 000 строк данных. .

Кроме того, если вы изучаете VBA, я настоятельно рекомендую вам никогда не использовать оператор On Error Resume Next, потому что он скрывает ошибки, но они все еще возникают.

Надеюсь, вы наконец-то закодируете это или, по крайней мере, найдете этот ответ полезным.

Но в любом случае, у вас еще есть много кода.

Answer 2

Надеемся, что приведенная ниже функция поможет вам облегчить эту задачу.Он удаляет все числовые символы из адресной строки и включает в себя любые конечные одиночные буквы.

Function getnumbersfromstring(address As String) As String
    For i = 1 To Len(address)
        If IsNumeric(Mid(address, i, 1)) Then getnumbersfromstring = getnumbersfromstring & Mid(address, i, 1) 
    Next i

    CharAfterNumber = Mid(address, Instr(1, address, getnumbersfromstring) + Len(getnumbersfromstring), 1)
    If IsNumeric(CharAfterNumber) = False And Not CharAfterNumber = " " And Not CharAfterNumber = "" Then
        getnumbersfromstring = getnumbersfromstring & CharAfterNumber
    End If
End Function

Эта функция может вызываться в обычном Sub, например, так:

Sub breakupaddress()

Dim r As Range
Dim c As Range
Dim addressnr As String

On Error Resume Next
Set r = Range(Range("E1"), Range("E" & Rows.Count).End(xlDown))
    For Each c In r
        addressnr = getnumbersfromstring(c.Value)
        MsgBox "The address number is '" & addressnr & "'.", vbInformation, "Information"
    Next c
End Sub