генератор RegExp, ошибка в макросе

[s.dandy]

Не могу разобраться в макросе, не знаю где искать ошибку в расчётах, помогите пожалуйста разобраться
Дело следующее: решил сделать генератор регулярных выражений, который автоматически создаёт нужные RegExp'ы при помощи макроса. Всё это для быстрого поиска нужных телефонов в базе данных. В столбец "B" копируются исходные данные из внешних источников, а при нажатии на соответствующие кнопки макрос отсеивает ненужные символы, оставляя только номер телефона. Номера вносятся в столбец "D", в уже подготовленном виде, чтобы следующий макрос создал регулярное выражение (нажатием на кнопку «генерация кода») и поместил его в ячейку "O6". Здесь и начинается проблема: макрос генерирует код, в конце которого содержится большое количество ненужных символов "|", от которых я не знаю, как избавиться. Код RegExp обязательно должен заканчиваться цифрой.  Для примера в ячейке "O7" я показал, каким должен получиться код.

[cheshiki1]

не хватает проверки на пустые ячейки.

Код Выделить Развернуть

If a(i, 1) <> "" Then
      s = s & Left(a(i, 1), 1)
      For j = 2 To Len(a(i, 1)): s = s & "[^[:digit:]]*" & Mid(a(i, 1), j, 1): Next
      s = s & "|"
      End If

[s.dandy]

cheshiki1

Спасибо за вариант решения. На другом форуме мне уже помог с сей задачей человек, который этот макрос и написал. Я перенёс данные в другой столбец, но не прописал это в коде.
Дело в этой строке:

Код Выделить Развернуть

    lr = .Cells(.Rows.Count, 2).End(xlUp).Row
а требовалось так:

Код Выделить Развернуть

    lr = .Cells(.Rows.Count, 4).End(xlUp).Row

Оба варианта работающего кода:

первый

Код Выделить Развернуть

Sub generate_multi()
  Dim lr&, a, i&, j&, s$
  With ActiveSheet
    lr = .Cells(.Rows.Count, 4).End(xlUp).Row
    a = .[d1].Resize(lr).Value
    For i = 1 To UBound(a)
      s = s & Left(a(i, 1), 1)
      For j = 2 To Len(a(i, 1)): s = s & "[^[:digit:]]*" & Mid(a(i, 1), j, 1): Next
      s = s & "|"
    Next
    s = Left(s, Len(s) - 1)
    Sheets("Ëèñò1").Range("O6").Value = s
  End With

End Sub

второй

Код Выделить Развернуть

Sub generate_multi()
  Dim lr&, a, i&, j&, s$
  With ActiveSheet
    lr = .Cells(.Rows.Count, 2).End(xlUp).Row
    a = .[d1].Resize(lr).Value
    For i = 1 To UBound(a)
      If a(i, 1) <> "" Then
      s = s & Left(a(i, 1), 1)
      For j = 2 To Len(a(i, 1)): s = s & "[^[:digit:]]*" & Mid(a(i, 1), j, 1): Next
      s = s & "|"
      End If
    Next
    s = Left(s, Len(s) - 1)
    Sheets("Ëèñò1").Range("O6").Value = s
  End With

End Sub