文本到行VBA Excel

我有一个大约有4000行数据的电子表格，其中一列数据具有唯一的订单号，我想用“/”作为分隔符分隔。 所以基本上我想要：

Name Order# Date Jane 123/001/111 08/15/2013 Gary 333/121 09/01/2013 Jack 222 09/02/2013 

看起来像这样：

 Name Order# Date Jane 123 08/15/2013 Jane 001 08/15/2013 Jane 111 08/15/2013 Gary 333 09/01/2013 Gary 121 09/01/2013 Jack 222 09/02/2013 

我对VBA相当陌生，所以我决定尝试谷歌的解决scheme，我find了这一点代码。

  Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim ans Dim Cels As Long, i As Long Cancel = True ans = Split(Target, ":") Cels = UBound(ans) Target.Offset(1).Resize(Cels).EntireRow.Insert shift:=xlDown Rows(Target.Row).Copy Cells(Target.Row + 1, "A").Resize(Cels) For i = 0 To Cels Target.Offset(i) = ans(i) Next End Sub 

它工作的很好，但这个macros的function是你必须双击行来分隔值。 我所希望的是通过一个For循环来传递这个函数的方法，这样它就可以在整个电子表格中执行。

Answer 1

如果你看起来有点像这样

然后

 Option Explicit Sub Main() Columns("B:B").NumberFormat = "@" Dim i As Long, c As Long, r As Range, v As Variant For i = 1 To Range("B" & Rows.Count).End(xlUp).Row v = Split(Range("B" & i), "/") c = c + UBound(v) + 1 Next i For i = 2 To c Set r = Range("B" & i) Dim arr As Variant arr = Split(r, "/") Dim j As Long r = arr(0) For j = 1 To UBound(arr) Rows(r.Row + j & ":" & r.Row + j).Insert Shift:=xlDown r.Offset(j, 0) = arr(j) r.Offset(j, -1) = r.Offset(0, -1) r.Offset(j, 1) = r.Offset(0, 1) Next j Next i End Sub 

会产生