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列（＆＃34; testa＆＃34;，＆＃34;第二＆＃34;等）和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

P.S。 BruceWayne是蝙蝠侠（现在他的封面已被炸毁）

如何在excel中分隔和转置行？

2 个答案: