使用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（專欄休息）Jeff Smith（專欄休息）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