Excel：拆分； 将单元格值分成几列，然后在连续的行中移动

Question

我处于图1所描述的情况，其中我有一个带有引用名称的单元格，以及一个带有一个或多个用分号分隔的与该引用相关联的电子邮件的单元格。 我想拆分包含多个电子邮件的单元格，这些单元格连续地堆叠它们并复制引用名称。 是否可以使用Excel 2007中的VBA宏来执行此操作？ 我知道“拆分为列”命令的存在，但是我不知道如何自动将行中的列移动并复制引用名称。 提前致谢。

Answer 1

干得好：

Sub SplitColumnB()
    Dim r As Range
    Set r = [B2]
    Do While r.Value <> ""
        res = Split(r.Value, " ; ")
        i = 0
        For Each resStr In res
            If i > 0 Then r.Offset(1).EntireRow.Insert xlDown
            r.Offset(IIf(i > 0, 1, 0)).Value = resStr
            r.Offset(IIf(i > 0, 1, 0), -1).Value = Right(resStr, Len(resStr) - InStr(resStr, "@"))
            i = i + 1
        Next
        Set r = r.Offset(IIf(i > 0, i, 1))
    Loop
End Sub

Answer 2

请尝试以下代码。 用工作表的名称替换Sheet1所有实例。

Sub test()

    Dim Ref As String
    Dim Eid As String
    Dim RefR()
    Dim EidR()

    Rcnt = Sheets("Sheet1").Range("A65000").End(xlUp).Row
    K = 0
    L = 0

    For i = 2 To Rcnt
        Ref = Sheets("Sheet1").Range("A" & i).Value
        Temp = Split(Sheets("Sheet1").Range("B" & i).Value, ";")
        K = K + 1
        ReDim Preserve RefR(1 To K)
        RefR(K) = Ref

        For j = LBound(Temp) To UBound(Temp)
            If L <= UBound(Temp) Then
                ReDim Preserve EidR(Rcnt, L)
                L = UBound(Temp)
            End If
            EidR(K, j) = Temp(j)
        Next j
    Next i

    RowValue = 2
    For i = 1 To UBound(RefR)
        For j = 0 To L

            Sheets("Sheet1").Range("A" & RowValue).Value = RefR(i)
            Sheets("Sheet1").Range("B" & RowValue).Value = Trim(EidR(i, j))
            RowValue = RowValue + 1
        Next j
    Next i

End Sub