我有一个VBA循环的内容，但我需要帮助使其“无限”

可能是我的问题的一个可怕的解释。 让我在这里尝试解释更好。

我写了一个代码，如果满足某些条件，它将从一个范围复制数据，如果符合不同的条件，则从另一个范围获取数据。 目前，我可以想象，只是继续下面的macros已经build立的模式，但我不认为用数千行代码达到100左右是明智的。 我到目前为止如下：

Sub Sort() Dim Rng As Range Dim i As Long Dim Pub1 As Range Dim Pub2 As Range Dim Pub3 As Range Dim Pub4 As Range Dim Pub5 As Range Dim Pub6 As Range i = 2 While i <= 800 Set Rng = Range("C" & i) Set Pub1 = Range("J" & i) Set Pub2 = Range("N" & i) Set Pub3 = Range("R" & i) Set Pub4 = Range("V" & i) Set Pub5 = Range("Z" & i) Set Pub6 = Range("AD" & i) If Rng.Offset(, 5) = "False" Then i = i + 1 ElseIf Rng.Offset(, 5) = "" Then i = i + 1 ElseIf Rng.Offset(, 5) = "True" And Pub2 = "" Then Rng.Offset(, 7).Resize(, 3).Copy Rng.PasteSpecial Paste:=xlPasteValues i = i + 1 ElseIf Rng.Offset(, 5) = "True" And Pub2 <> "" And Pub3 = "" Then Rng.Offset(, -2).Resize(, 670).Copy Rng.Offset(1, -2).Insert Shift:=xlDown Rng.Offset(, 7).Resize(, 3).Copy Rng.PasteSpecial Paste:=xlPasteValues Rng.Offset(, 11).Resize(, 3).Copy Rng.Offset(1, 0).PasteSpecial Paste:=xlPasteValues i = i + 2 ElseIf Rng.Offset(, 5) = "True" And Pub3 <> "" And Pub4 = "" Then Rng.Offset(, -2).Resize(, 670).Copy Rng.Offset(1, -2).Insert Shift:=xlDown Rng.Offset(, -2).Resize(, 670).Copy Rng.Offset(1, -2).Insert Shift:=xlDown Rng.Offset(, 7).Resize(, 3).Copy Rng.PasteSpecial Paste:=xlPasteValues Rng.Offset(, 11).Resize(, 3).Copy Rng.Offset(1, 0).PasteSpecial Paste:=xlPasteValues Rng.Offset(, 15).Resize(, 3).Copy Rng.Offset(2, 0).PasteSpecial Paste:=xlPasteValues i = i + 3 ElseIf Rng.Offset(, 5) = "True" And Pub4 <> "" And Pub5 = "" Then Rng.Offset(, -2).Resize(, 670).Copy Rng.Offset(1, -2).Insert Shift:=xlDown Rng.Offset(, -2).Resize(, 670).Copy Rng.Offset(1, -2).Insert Shift:=xlDown Rng.Offset(, -2).Resize(, 670).Copy Rng.Offset(1, -2).Insert Shift:=xlDown Rng.Offset(, 7).Resize(, 3).Copy Rng.PasteSpecial Paste:=xlPasteValues Rng.Offset(, 11).Resize(, 3).Copy Rng.Offset(1, 0).PasteSpecial Paste:=xlPasteValues Rng.Offset(, 15).Resize(, 3).Copy Rng.Offset(2, 0).PasteSpecial Paste:=xlPasteValues Rng.Offset(, 19).Resize(, 3).Copy Rng.Offset(3, 0).PasteSpecial Paste:=xlPasteValues i = i + 4 ElseIf Rng.Offset(, 5) = "True" And Pub5 <> "" And Pub6 = "" Then Rng.Offset(, -2).Resize(, 670).Copy Rng.Offset(1, -2).Insert Shift:=xlDown Rng.Offset(, -2).Resize(, 670).Copy Rng.Offset(1, -2).Insert Shift:=xlDown Rng.Offset(, -2).Resize(, 670).Copy Rng.Offset(1, -2).Insert Shift:=xlDown Rng.Offset(, -2).Resize(, 670).Copy Rng.Offset(1, -2).Insert Shift:=xlDown Rng.Offset(, 7).Resize(, 3).Copy Rng.PasteSpecial Paste:=xlPasteValues Rng.Offset(, 11).Resize(, 3).Copy Rng.Offset(1, 0).PasteSpecial Paste:=xlPasteValues Rng.Offset(, 15).Resize(, 3).Copy Rng.Offset(2, 0).PasteSpecial Paste:=xlPasteValues Rng.Offset(, 19).Resize(, 3).Copy Rng.Offset(3, 0).PasteSpecial Paste:=xlPasteValues Rng.Offset(, 23).Resize(, 3).Copy Rng.Offset(4, 0).PasteSpecial Paste:=xlPasteValues i = i + 5 Else Stop End If Wend End Sub 

这个脚本已经很臃肿了，如果我想扩展它来包含Pub50或者Pub 60，那么我需要写更多的行。 是否有可能插入一些信息来描述，例如，复制的列偏移将增加4，而行将增加1，直到达到一定的限制？

代码的目的是查看一长串数据，并说：“如果有4个进入者（Pub4 <>”“和Pub5 =”“），则取数据并为每个数据点形成1个新行。

提前致谢！

Answer 1

我写了一个快速的recursion子程序来replace你的if - elseif的内部。 它应该至less大大减less代码行的数量，因为你可以简单地增加你的参数来匹配你的函数。

 function recursive [(j,j)] buffer = j % Line to add the i=i+1 at the end of your blocks% if j=0 Then Rng.Offset(, -2).Resize(, 670).Copy; Rng.Offset(1, -2).Insert Shift:=xlDown; Rng.Offset(, 7).Resize(, 3).Copy; Rng.PasteSpecial Paste:=xlPasteValues; buffer = buffer + 1; else Rng.Offset(, -2).Resize(, 670).Copy; Rng.Offset(1, -2).Insert Shift:=xlDown; Rng.Offset(, 7+4*j).Resize(, 3).Copy; Rng.Offset(j,0).PasteSpecial Paste:=xlPasteValues; recursive [(j-1,buffer)]; end if end recursive 

它应该按预期工作。 当然这只是朝着正确的方向迈出的一步，但至less应该让其他人更容易阅读。 我通常不会在VBA中编写代码，但是我不认为我使用的符号是错误的，告诉我是否需要编辑这个，如果你看到任何错误。

然而，我不确定我的“缓冲区”方法是否相当优雅，您可能需要按照您的意愿进行修改。