使用VBA从Excel单元中分离和堆叠数据

我有一个excel文件，所有的数据被转储到4个单元格。 列A有一个标题，然后有4个开始时间（每次都是一样的），B列有一个标题，然后每个4个单元格每天包含不同数量的电子邮件地址和其他细节，所以VBA必须不pipeB列的细胞密度如何

我想要实现的是每个电子邮件地址整齐堆叠的数据行，无论在某一天的单元格中的地址数量如何。 数据被格式化，行间隔由; 和列中断，所以

Jeffsmith @ gmail.com，Jeff Smith，555-4196; BobJones @ Gmail.com，Bob Jones，555-3827（全部在B2）

需要成为

[e-mail]（分栏符）Jeff Smith（分栏符）555-4196

（行rest）

[e-mail]（分栏符）Bob Jones（分栏符）555-3827

等等每个单元格到目前为止，我已经尝试使用插入与下面的代码

RowNum1 = (Len(Range("B2")) - Len(Replace(Range("B2"), "@", ""))) RowNum2 = (Len(Range("B3")) - Len(Replace(Range("B3"), "@", ""))) RowNum3 = (Len(Range("B4")) - Len(Replace(Range("B4"), "@", ""))) RowNum4 = (Len(Range("B5")) - Len(Replace(Range("B5"), "@", ""))) If RowNum1 <> 0 Then Rows("3:" & 1 + RowNum1).EntireRow.Insert End If If RowNum2 <> 0 Then Rows(3 + RowNum1 & ":" & 1 + RowNum1 + RowNum2).EntireRow.Insert End If If RowNum3 <> 0 Then Rows(3 + RowNum1 + RowNum2 & ":" & 2 + RowNum1 + RowNum2 + RowNum3).EntireRow.Insert End If 

而且这似乎把正确的行分割成数据（我不是100％），但是当分离数据并把它放在需要的地方时，我很难。 任何帮助将不胜感激。

Answer 1

我没有打扰date。 但是这会为你分割范围B2。

 Sub ExplodeB2() Const SampleString = "[e-mail],Jeff Smith,555-4196;[e-mail],Bob Jones,555-3827 (all in B2)" Dim x As Long Dim arrRows arrRows = Split(Range("B2").Value, ";") For x = 0 To UBound(arrRows) Cells(x + 2, 2).Resize(1, 3) = Split(arrRows(x), ",") Next End Sub 

之前和之后

Answer 2

对于多个单元格，可以在分割单元格之前将单元格值join到一个string中：

 Set rangeFrom = [B2:B5] Set rangeTo = [D2] a = WorksheetFunction.Transpose(rangeFrom) ' from 2D array to 1D array s = Join(a, ";") a = Split(s, ";") ' sorry about my lazy variable names :] For Each s In a v = Split(s, ",") ' 3 values c = UBound(v) + 1 ' UBound(v) is 2 rangeTo.Resize(, c) = v ' resize to 3 columns Set rangeTo = rangeTo(2) ' moves to the cell below Next