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

Question

我有一个excel文件，其中所有数据都被转储到4个单元格中。 A列有一个标题，然后是4个开始时间（每次都是相同的），B列有一个标题，然后是4个单元格，每个单元格每天都包含不同数量的电子邮件地址和其他详细信息，因此VBA必须无论B栏中的细胞密度如何，都可以工作。

我想要实现的是每个电子邮件地址一个整齐堆叠的数据行，无论给定日期单元格中的地址数量是多少。数据的格式为行分隔符;并且列分隔符被分隔，所以

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

需要成为

Jeffsmith@gmail.com（专栏休息）杰夫史密斯（专栏文章）555-4196

（分行）

BobJones@Gmail.com（专栏文章）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

我没有打扰日期。但这将为您分割范围B2。

Sub ExplodeB2()
    Const SampleString = "Jeffsmith@gmail.com,Jeff Smith,555-4196;BobJones@Gmail.com,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

对于多个单元格，您可以在拆分它们之前将单元格值连接到一个字符串：

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