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

【问题标题】：Using VBA to separate and stack data from an Excel Cell使用 VBA 从 Excel 单元格中分离和堆叠数据
【发布时间】：2016-07-28 09:49:04
【问题描述】：

我有一个 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%），但在分离数据并将其放在需要的位置时，我感到很困惑。任何帮助将不胜感激。

【问题讨论】：

这可能对你有帮助：Split Function
尝试结合宏记录器和文本到列向导。这将为您编写大部分代码。

标签： vba excel

【解决方案1】：

我没有在意日期。但这会为您拆分 Range 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

之前和之后

【讨论】：

【解决方案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

【讨论】：