如何在Excel中分隔和转置行?

我有两列的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 

现在我手动分离它,有没有这样的macros/ VBA?

我碰巧有一个这样的macros,所以我只是调整它来匹配你的数据。 否则,我也要求你先做一些努力。 我假设你的数据在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 

(这是一个较老的macros,但它会检查出来,你可能会更有效率)

当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 

PS布鲁斯·韦恩是蝙蝠侠(现在他的封面被吹)