vba 如何根据列内容复制excel中的行？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/10009699/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
提示：将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间：2020-09-11 15:44:04 来源:igfitidea点击:
How to duplicate rows in excel based on column content?
提问by onedevteam.com
I have following data in excel table
我在excel表中有以下数据
r1 r2 r3 r4 r5
v1 v2 r3 r4 r5
x1 x2 r4 r5
is it posible (and how) to convert this data to structure like:
是否可以（以及如何）将此数据转换为如下结构：
r1 r2 r3
r1 r2 r4
r1 r2 r5
v1 v2 r3
v1 v2 r4
v1 v2 r5
x1 x2 r4
x1 x2 r5
thanks in advance
提前致谢
回答by Siddharth Rout
Is this what you are trying?
这是你正在尝试的吗？
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
SNAPSHOT
快照
回答by brettdj
This method uses arrays to avoid range loops. It dumps a range from column A:E to F:H
此方法使用数组来避免范围循环。它转储从列 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
