如何根据列内容在Excel中复制行？

我在Excel表中有以下数据

r1 r2 r3 r4 r5 v1 v2 r3 r4 r5 x1 x2 r4 r5 

这是可行的（以及如何）将这些数据转换为像这样的结构：

 r1 r2 r3 r1 r2 r4 r1 r2 r5 v1 v2 r3 v1 v2 r4 v1 v2 r5 x1 x2 r4 x1 x2 r5 

提前致谢

Answer 1

这是你正在尝试？

 Sub Sample() Dim wsI As Worksheet, wsO As Worksheet Dim wsIlRow As Long, wsOlRow As Long, i As Long, j As Long Set wsI = Sheets("Sheet1") Set wsO = Sheets("Sheet2") wsIlRow = wsI.Range("A" & wsI.Rows.Count).End(xlUp).Row wsOlRow = 1 For i = 1 To wsIlRow For j = 3 To 5 If Len(Trim(wsI.Cells(i, j).Value)) <> 0 Then wsO.Range("A" & wsOlRow).Value = wsI.Range("A" & i).Value wsO.Range("B" & wsOlRow).Value = wsI.Range("B" & i).Value wsO.Range("C" & wsOlRow).Value = wsI.Cells(i, j).Value wsOlRow = wsOlRow + 1 End If Next j Next i End Sub 

快照

Answer 2

此方法使用数组来避免范围循环。 它转储从列A：E到F：H的范围

 Sub MoveEM() Dim rng1 As Range Dim X Dim Y Dim lngRow As Long Dim lngCol As Long Dim lngCnt As Long Set rng1 = Range([a1], Cells(Rows.Count, "E").End(xlUp)) X = rng1.Value2 ReDim Y(1 To 3 * UBound(X, 1), 1 To 3) For lngRow = 1 To UBound(X, 1) For lngCol = 1 To 3 lngCnt = lngCnt + 1 Y(lngCnt, 1) = X(lngRow, 1) Y(lngCnt, 2) = X(lngRow, 2) Y(lngCnt, 3) = X(lngRow, 2 + lngCol) Next Next [f1].Resize(UBound(Y, 1), UBound(Y, 2)) = Y End Sub