Question

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

我编写的代码将在满足某些条件时从一个范围复制数据，或者在满足不同条件时从另一个范围获取数据。目前，我可以想象只是继续下面的宏中已经建立的模式，但我认为用数千行代码达到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＆lt;＆gt;”和Pub5 =“”），则获取数据并形成1个新行每个数据点。

提前致谢！

Answer 1

我写了一个快速递归子程序来替换if - elseif的内部。它应该至少减少代码行数，因为你可以简单地增加你的参数以匹配你的函数的comportment。

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

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

但我不确定我的“缓冲”方法是否非常优雅，您可能希望随意修改它。

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

1 个答案: