使用VBA代码创建空行 - 请帮助 [英] Issue with VBA code to create blank row - Please Help
问题描述
大家好，
我有以下数据集（图1）。我想要做的是基本上根据重复量创建空行。
I have the following set of Data (Picture 1). What I am trying to do is basically create blank row based on the repeat amount.
使用下面的代码我能够在VBA中生成结果。但是，当我运行两次时，代码会生成不同的结果。代码一定有问题，请帮我看看，让我知道我的代码有什么问题，或者任何带有更好代码的
建议也会很棒！
Using the code below i was able to generate the results in VBA. However, the code generate different results when I run it twice. There must be something wrong with the code, please help me a take a look and let me know what is wrong with my code or any suggestion with better code would be great as well!
数据
ID Route_ID Begin_Point End_Point Length Repeat
1 ALA_CO_GRANT LINE RD_P 2.709 4.642 1.933 3
2 AMA_CO_CAMANCHE PKWY N_P 0 2.972 2.972 5
3 AMA_CO_CAMANCHE PKWY N_P 5.774 6.052 0.278 1
4 AMA_CO_CAMANCHE PKWY N_P 7.565 8.821 1.256 2
5 AMA_CO_CLIMAX RD_P 1.798 2.164 0.366 1
6 AMA_CO_CLIMAX RD_P 2.704 3.109 0.405 1
7 AMA_CO_EUREKA RD_P 0.022 0.216 0.194 1
8 AMA_CO_FIDDLETOWN RD_P 7.122 7.525 0.403 1
9 AMA_CO_FIDDLETOWN RD_P 7.615 8.124 0.509 1
10 AMA_CO_FIDDLETOWN RD_P 8.268 10.775 2.507 5
代码
Sub ADD_ROW()
Dim lRow As Long
Dim RepeatFactor As Variant
lRow = 2
Do While (Cells(lRow, "A") <> "")
RepeatFactor = Cells(lRow, "F") + 1
If ((RepeatFactor > 1) And IsNumeric(RepeatFactor)) Then
Range(Cells(lRow + 1, "A"), Cells(lRow + RepeatFactor - 1, "F")).Select
Selection.Insert Shift:=xlDown
lRow = lRow + RepeatFactor - 1
End If
lRow = lRow + 1
Loop
End Sub首次运行（效果不错）
ID Route_ID Begin_Point End_Point Length Repeat
1 ALA_CO_GRANT LINE RD_P 2.709 4.642 1.933 3
2 AMA_CO_CAMANCHE PKWY N_P 0 2.972 2.972 5
3 AMA_CO_CAMANCHE PKWY N_P 5.774 6.052 0.278 1
4 AMA_CO_CAMANCHE PKWY N_P 7.565 8.821 1.256 2
5 AMA_CO_CLIMAX RD_P 1.798 2.164 0.366 1
6 AMA_CO_CLIMAX RD_P 2.704 3.109 0.405 1
7 AMA_CO_EUREKA RD_P 0.022 0.216 0.194 1
8 AMA_CO_FIDDLETOWN RD_P 7.122 7.525 0.403 1
9 AMA_CO_FIDDLETOWN RD_P 7.615 8.124 0.509 1
10 AMA_CO_FIDDLETOWN RD_P 8.268 10.775 2.507 5
第二次运行（结果不佳）
ID Route_ID Begin_Point End_Point Length Repeat
1 ALA_CO_GRANT LINE RD_P 2.709 4.642 1.933 3
ID Route_ID Begin_Point End_Point Length Repeat
1 ALA_CO_GRANT LINE RD_P 2.709 4.642 1.933 3
2 AMA_CO_CAMANCHE PKWY N_P 0 2.972 2.972 5
3 AMA_CO_CAMANCHE PKWY N_P 5.774 6.052 0.278 1
4 AMA_CO_CAMANCHE PKWY N_P 7.565 8.821 1.256 2
5 AMA_CO_CLIMAX RD_P 1.798 2.164 0.366 1
6 AMA_CO_CLIMAX RD_P 2.704 3.109 0.405 1
7 AMA_CO_EUREKA RD_P 0.022 0.216 0.194 1
8 AMA_CO_FIDDLETOWN RD_P 7.122 7.525 0.403 1
9 AMA_CO_FIDDLETOWN RD_P 7.615 8.124 0.509 1
10 AMA_CO_FIDDLETOWN RD_P 8.268 10.775 2.507 5
推荐答案
在这种情况下，最好向后循环：
In situations like this, it is better to loop backwards:
Sub ADD_ROW（ ）
Dim lRow As Long
Dim lLastRow As Long
Dim RepeatFactor As Long
Sub ADD_ROW()
Dim lRow As Long
Dim lLastRow As Long
Dim RepeatFactor As Long
lLastRow = Range（"A"& Rows.Count）.End（xlUp）.Row
对于lRow = lLastRow To 2 Step -1
$
RepeatFactor = Val（范围（"F"& lRow）.Value）
如果RepeatFactor> 0然后
范围（"A"& lRow + 1）.Resize（RepeatFactor，6）.Insert Shift：= xlShiftDown
结束如果是
下一页lRow
End Sub
lLastRow = Range("A" & Rows.Count).End(xlUp).Row
For lRow = lLastRow To 2 Step -1
RepeatFactor = Val(Range("F" & lRow).Value)
If RepeatFactor > 0 Then
Range("A" & lRow + 1).Resize(RepeatFactor, 6).Insert Shift:=xlShiftDown
End If
Next lRow
End Sub
这篇关于使用VBA代码创建空行 - 请帮助的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
