Раздельная адресная колонка

Мне нужно взять базу данных Excel с настройкой столбца адреса, например: «Физический адрес, Почтовый адрес, Костюм №; Город, ST; Почтовый индекс» в столбцы, разделенные точкой с запятой.

К сожалению, у меня есть данные внутри столбца Address, у которого есть ссылки на ASCII-символы, которые не позволяют мне просто использовать «Text to Columns», поэтому я разработал следующий код, но он не делает того, чего я хочу. Диапазон, который я разделяю, находится в столбце B.

Sub SplitAddress() Dim txt As String Dim i As Integer Dim j As Integer Dim Address As Variant Dim Rng As Range Dim Row As Range Dim LastRow As Integer txt = ActiveCell.Value Address = Split(txt, "; ") LastRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row Rng = Range("B3:B" & LastRow) j = 1 For Each Row In Rng.Rows For i = 0 To UBound(Address) Cells(3, j + 1).Value = Address(i) Next i Next Row End Sub 

Может быть:

 Sub SplitAddress() Dim txt As String Dim i As Integer Dim j As Integer Dim Address As Variant Dim Rng As Range Dim R As Range Dim LastRow As Integer LastRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row Set Rng = Range("B3:B" & LastRow) For Each R In Rng txt = R.Value Address = Split(txt, "; ") j = R.Row For i = 0 To UBound(Address) Cells(j, i + 3).Value = Address(i) Next i Next R End Sub 

EDIT # 1 :

Лучше сделать i, j, LastRow Long, а не целое :

 Sub SplitAddress() Dim txt As String Dim i As Long Dim j As Long Dim Address As Variant Dim Rng As Range Dim R As Range Dim LastRow As Long LastRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row Set Rng = Range("B3:B" & LastRow) For Each R In Rng txt = R.Value Address = Split(txt, "; ") j = R.Row For i = 0 To UBound(Address) Cells(j, i + 3).Value = Address(i) Next i Next R End Sub 

РЕДАКТИРОВАТЬ № 2 :

Эта версия перемещает результат влево и, таким образом, переписывает столбец B :

 Sub SplitAddress() ' version #3 - overwrites column B Dim txt As String Dim i As Long Dim j As Long Dim Address As Variant Dim Rng As Range Dim R As Range Dim LastRow As Integer LastRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row Set Rng = Range("B3:B" & LastRow) For Each R In Rng txt = R.Value Address = Split(txt, "; ") j = R.Row For i = 0 To UBound(Address) Cells(j, i + 2).Value = Address(i) Next i Next R End Sub 
Давайте будем гением компьютера.