Excel：分割; 将单元格值分隔成列，然后在连续的行中移位

我处于图1所描述的情况，其中有一个单元格，引用名称和一个单元格，其中有一个或多个分号分隔的电子邮件，与同一个引用相关联。 我想拆分包含多个电子邮件的单元格，将它们连续堆叠在一起，然后复制该名称。 是否有可能在Excel 2007中使用VBAmacros来做到这一点？ 我知道“Split in columns”命令的存在，但我不知道如何自动移动行中的列并复制引用名称。 提前致谢。

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所有实例replace为工作表的名称。

 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