本文介绍了使用VBA代码创建空行 - 请帮助的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

大家好,

我有以下数据集(图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
					
					
					
					
					







推荐答案

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代码创建空行 - 请帮助的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!

10-28 20:18