如何在excel中分离和转换行？

Question

我有带有两列的excel工作表，第一列包含名称，第二列包含多个分号分隔的值，我想分隔第二列，并使用重复的第一列值转置，

示例表：

testa   KRAS;EGFR
second  HSP90AB1;KSR1;PLXND1;LAMB2;ROCK2
test    PPP2R1A;TRIB3;EGFR;FGFR2

结果：

testa   KRAS
testa   EGFR
second  HSP90AB1
second  KSR1
second  PLXND1
second  LAMB2
second  ROCK2
test    PPP2R1A
test    TRIB3
test    EGFR
test    FGFR2

现在我正在手动分离它，有宏/VBA吗？

Answer 1

我碰巧有一个宏，它几乎就是这样做的，所以我调整它来匹配你的数据。否则，我也会要求你先表现出一些努力。我假设您的数据位于A列("testa“、"second”等)和B列(分隔数据)中。

Sub splitCopyDown()
Dim rng As Range, cel As Range
Dim cols As Long, lastRow As Long, i As Long, k As Long

Set rng = Range("B1:B" & Cells(Rows.Count, 2).End(xlUp).Row)
rng.TextToColumns Destination:=Range("B1"), Semicolon:=True

lastRow = Cells(Rows.Count, 2).End(xlUp).Row

For i = lastRow To 1 Step -1
    cols = Cells(i, Columns.Count).End(xlToLeft).Column
    Set rng = Range(Cells(i, 3), Cells(i, cols))
    Range(rng.Offset(1, 0), rng.Offset(cols - 2, 0)).EntireRow.Insert
    rng.Copy
    rng.Cells(1).Offset(1, -1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    rng.Clear
Next i

lastRow = Cells(Rows.Count, 2).End(xlUp).Row
Range(Cells(1, 1), Cells(lastRow, 1)).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=r[-1]c"
Range(Cells(1, 1), Cells(lastRow, 1)).Value = Range(Cells(1, 1), Cells(lastRow, 1)).Value
End Sub

(这是一个较旧的宏，但它已经检查过了。你可能会让它更有效率)

Answer 2

当BruceWayne击败我的时候，我很快就记下了这个子例程，所以我想我应该分享它，这样我就不会觉得我浪费了一天中的5分钟。

Sub liftAndSeperate()
    Dim rngData As Range
    Dim intWriteRow As Integer
    Dim rngReadRow As Range
    Dim readArrayElem As Variant

    'Assuming the data is in Sheet1 A1:B20
    Set rngData = Sheet1.Range("A1:B20")

    'Assuming we will write to Sheet2 starting at row 1:
    intWriteRow = 1

    'Loop through each row in that range:
    'The row we are reading will be held in variable rngReadRow
    For Each rngReadRow In rngData.Rows

        'Generate an array using split and loop through the array to write the values out
        For Each readArrayElem In Split(rngReadRow.Cells(1, 2).Value, ";")

            'Write out column A from sheet1 to sheet2
            Sheet2.Cells(intWriteRow, 1).Value = rngReadRow.Cells(1, 1)

            'Write out the array element
            Sheet2.Cells(intWriteRow, 2).Value = readArrayElem

            'Increment to the next write row
            intWriteRow = intWriteRow + 1
        Next readArrayElem
    Next rngReadRow
End Sub

附注：BruceWayne是蝙蝠侠(现在他的身份暴露了)