分割字段和重复行的内容

我有一个Excel电子表格，其中有一列可能有许多值由分号分隔，例如value1; value2; value3。 我需要做的是复制整个行的每个值，每行只有一个值。

例：

value1;value2;value3,abc,100 value4;value5,xyz,200 value6,def,300 

应该像这样结束：

 value1,abc,100 value2,abc,100 value3,abc,100 value4,xyz,200 value5,xyz,200 value6,def,300 

Answer 1

您可以使用下面的代码来分割和写入数据到不同的工作表…

工作表1包含input，工作表2包含您请求的输出…

 Dim i As Integer Dim j As Integer Dim k As Integer Dim x As Integer Dim y As Integer i = 1 'Row j = 1 'Col 'Destination Row & Col x = 1 y = 1 While (Trim(ThisWorkbook.Sheets("Sheet1").Cells(i, j).Value) <> "") Dim CellValue1 As String Dim CellValue2 As String Dim CellValue3 As String Dim ValArray() As String Dim arrayLength As Integer CellValue1 = Trim(ThisWorkbook.Sheets("Sheet1").Cells(i, j).Value) CellValue2 = Trim(ThisWorkbook.Sheets("Sheet1").Cells(i, (j + 1)).Value) CellValue3 = Trim(ThisWorkbook.Sheets("Sheet1").Cells(i, (j + 2)).Value) ValArray = Split(CellValue1, ";") arrayLength = UBound(ValArray, 1) - LBound(ValArray, 1) + 1 k = 0 While (k < arrayLength) 'MsgBox ((ValArray(k) & CellValue2 & CellValue3)) ThisWorkbook.Sheets("Sheet2").Cells(x, y).Value = ValArray(k) y = y + 1 ThisWorkbook.Sheets("Sheet2").Cells(x, y).Value = CellValue2 y = y + 1 ThisWorkbook.Sheets("Sheet2").Cells(x, y).Value = CellValue3 x = x + 1 y = 1 k = k + 1 Wend i = i + 1 Wend 

Answer 2

使用列A中的数据这个macros：

 Sub Byron() Dim r As Range, K As Long, v As String K = 1 For Each r In Intersect(Range("A:A"), ActiveSheet.UsedRange) v = r.Value p1 = Mid(v, 1, InStr(1, v, ",") - 1) p2 = Mid(v, InStr(1, v, ",")) ary = Split(p1, ";") For Each a In ary Cells(K, 2).Value = a & p2 K = K + 1 Next a Next r End Sub 

会把结果放在B列：

（这只是拜伦对VBA的评论的翻译）