vba Excel 宏 - 如何根据特定单元格值复制/拆分行
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/5423602/
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
Excel Macro - How to copy/split row based on specific cell value
提问by Silvertree
I'm dealing with a huge spreadsheet and needed some help with a particular Macro I want to write for it.
我正在处理一个巨大的电子表格，需要一些关于我想为其编写的特定宏的帮助。
I have a whole bunch of information pertaining to what equipment goes in which room. Each room has its own row for the type of equipment being installed. Sometimes one room has more than one of the same equipment and is specified in the quantity column. I need to split/copy such rows so that each equipment has its own row.
我有一大堆关于在哪个房间里放什么设备的信息。每个房间都有自己的一排用于安装的设备类型。有时一个房间有不止一台相同的设备，并在数量列中指定。我需要拆分/复制这些行，以便每个设备都有自己的行。
What I have currently:
我目前拥有的：
A B C
Equip. Name Rm Number Quantity
xxxxx 1.2.3.4 5
yyyyy 1.2.3.4 1
What I need the macro to do for me: Find and copy all the rows with quantity greater than 1 into the following rows below the same number times as the quantity value and replace it all with quantity of 1 for the whole spreadsheet.
我需要宏为我做什么：查找数量大于 1 的所有行并将其复制到与数量值相同数量的以下行中，并将整个电子表格的数量全部替换为 1。
A B C
Equip. Name Rm Number Quantity
xxxxx 1.2.3.4 1
xxxxx 1.2.3.4 1
xxxxx 1.2.3.4 1
xxxxx 1.2.3.4 1
xxxxx 1.2.3.4 1
yyyyy 1.2.3.4 1
Thank you in advance.
先感谢您。
回答by chris neilsen
To expand the rows in place, thae attached macro will follow this pattern:
要扩展行，附加的宏将遵循以下模式：
- Loop thru your data, starting at the last row
- If Quantity > 1,
- Insert rows to make space
- copy row data down
- set Quantity to 1
- 从最后一行开始循环遍历您的数据
- 如果数量 > 1，
- 插入行以腾出空间
- 向下复制行数据
- 将数量设置为 1
.
.
Sub ExpandRows()
Dim dat As Variant
Dim i As Long
Dim rw As Range
Dim rng As Range
Set rng = ActiveSheet.UsedRange
dat = rng
' Loop thru your data, starting at the last row
For i = UBound(dat, 1) To 2 Step -1
' If Quantity > 1
If dat(i, 3) > 1 Then
' Insert rows to make space
Set rw = rng.Rows(i).EntireRow
rw.Offset(1, 0).Resize(dat(i, 3) - 1).Insert
' copy row data down
rw.Copy rw.Offset(1, 0).Resize(dat(i, 3) - 1)
' set Quantity to 1
rw.Cells(1, 3).Resize(dat(i, 3), 1) = 1
End If
Next
End Sub
