拆分地址列

Question

我需要一个具有Address列设置的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

Answer 1

也许：

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

修改＃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