VBA to Create Data rows for Multi-Valued Columns

[大灰狼1976]

ok!

Private Sub test()
Dim i&, arr, s$
Application.ScreenUpdating = False
With Sheets("Data")
  For i = .[a65536].End(3).Row To 2 Step -1
    s = Replace(.Cells(i, 4), ".", ";")
    arr = Split(s, "; ")
    If UBound(arr) > 0 Then
      .Rows(i).Copy
      .Rows(i + 1 & ":" & i + UBound(arr)).Insert Shift:=xlDown
      .Cells(i, 4).Resize(UBound(arr) + 1) = Application.Transpose(arr)
    End If
  Next i
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub