拆分字段和重复行的内容

Question

我有一个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

对于 A 列中的数据，此宏：

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 列

列中

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

Answer 2

您可以使用以下代码将数据拆分并写入不同的表单...

工作表1包含输入，工作表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