VBA分列

Sub fenlie()

Dim dict1 As Object
Set dict1 = CreateObject("scripting.dictionary")
 
maxr1 = Range("d65536").End(xlUp).Row
arr1 = Range("a1:a" & maxr1)
 
For Each i In arr1
    dict1(i) = Split(i, " ")
Next
 
arr2 = dict1.Keys()
arr3 = dict1.Items()
 
For J = LBound(arr3) To UBound(arr3)
    m = 1
    For Each K In arr3(J)
        Cells(J + 1, 4 + m) = K
        m = m + 1
    Next
Next
End Sub
Sub test()

Dim rng As Range, arr, a As Range

Set rng = Application.InputBox("请选择需要拆分的单元格区域", "单元格的处理", , , , , , 8)

For Each a In rng

str1 = rng.Text
str1 = Replace(str1, "  ", " ")
arr = Split(str1, " ")

ii = UBound(arr) + 1

For i = 1 To ii
If i Mod 2 = 0 Then
'rng.Offset(0, i) = arr(i - 1)
rng.Offset(0, i + 1) = arr(i - 1)
End If
Next i

Next a

End Sub