VBA编译错误:程序太长。

How could I shorten this code? Forgive me for bad coding practices I'm self taught and pretty much a noob.

我怎么能缩短这段代码呢?请原谅我的错误编码实践，我是自学的，几乎是一个新手。

The code is comprised of 199 "Elseif" statements, I don't know any other way to write what i'm trying to do.

代码由199“Elseif”语句组成，我不知道还有什么其他方法可以写我正在尝试做的事情。

Sub CopytoRoutine()


If Sheets("iPhone view").Range("A2") = Sheets("Routine").Range("B9") And Sheets("iPhone     view").Range("A3") = Sheets("Routine").Range("C7") Then
Range("A5:B5").Select
Selection.Copy
Sheets("Routine").Select
Range("C9:D9").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    True, Transpose:=FalseL

ElseIf Sheets("iPhone view").Range("A2") = Sheets("Routine").Range("B10") And     Sheets("iPhone view").Range("A3") = Sheets("Routine").Range("C7") Then
Range("A5:B5").Select
Selection.Copy
Sheets("Routine").Select
Range("C10:D10").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    True, Transpose:=False

ElseIf Sheets("iPhone view").Range("A2") = Sheets("Routine").Range("B11") And     Sheets("iPhone view").Range("A3") = Sheets("Routine").Range("C7") Then
Range("A5:B5").Select
Selection.Copy
Sheets("Routine").Select
Range("C11:D11").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    True, Transpose:=False

ElseIf Sheets("iPhone view").Range("A2") = Sheets("Routine").Range("B12") And Sheets("iPhone view").Range("A3") = Sheets("Routine").Range("C7") Then
Range("A5:B5").Select
Selection.Copy
Sheets("Routine").Select
Range("C12:D12").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    True, Transpose:=False

ElseIf Sheets("iPhone view").Range("A2") = Sheets("Routine").Range("B13") And    Sheets("iPhone view").Range("A3") = Sheets("Routine").Range("C7") Then
Range("A5:B5").Select
Selection.Copy
Sheets("Routine").Select
Range("C13:D13").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    True, Transpose:=False

ElseIf Sheets("iPhone view").Range("A2") = Sheets("Routine").Range("B14") And Sheets("iPhone view").Range("A3") = Sheets("Routine").Range("C7") Then
Range("A5:B5").Select
Selection.Copy
Sheets("Routine").Select
Range("C14:D14").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    True, Transpose:=False

ElseIf Sheets("iPhone view").Range("A2") = Sheets("Routine").Range("B15") And    Sheets("iPhone view").Range("A3") = Sheets("Routine").Range("C7") Then
Range("A5:B5").Select
Selection.Copy
Sheets("Routine").Select
Range("C15:D15").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    True, Transpose:=False

Sheets("Routine").Range("Bx") Where x= 9-29

表(“常规”).Range(“软”)x = 9-29

Sheets("Routine").Range("C7"), this range changes to G7,K7,O7,S7,...AM7. when the above gets to B29

表(“常规”). range(“C7”)，这个范围变化到G7,K7,O7,S7，…AM7。当上述值达到B29时。

The column letter for Range("C9:D9").Select changes respectively with the above, so do the row numbers

范围的列字母(“C9:D9”)。分别选择与上面的更改，所以行号。

So I could essentially do something like this?

我可以这样做?

Sub CopytoRoutine()

Dim wb As Workbook
Dim cpuview As Worksheet
Dim routine As Worksheet

Set wb = ThisWorkbook
Set cpuview = wb.Sheets("iPhone view")
Set routine = wb.Sheets("Routine")

Dim x As Integer

For x = 9 To 29




If cpuview.Range("A2") = routine.Range("Bx") And cpuview.Range("A3") = routine.Range("C7")     Then
Range("A5:B5").Select
Selection.Copy
routine.Select
Range("Cx:Dx").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    True, Transpose:=False

1 个解决方案

#1

There are several things you can do. First of all, it looks like you're checking the following in every one of your if statements:

有几件事你可以做。首先，看起来你在每一个if语句中检查以下内容:

And Sheets("iPhone view").Range("A3") = Sheets("Routine").Range("C7")

You only need to run that test once until "C7" changes to "D7". You can do that like this, although we'll optimize it even more in a little bit:

您只需要运行一次测试，直到“C7”更改为“D7”。你可以这样做，虽然我们会进一步优化它:

If Sheets("iPhone view").Range("A3") = Sheets("Routine").Range("C7")
    If Sheets("iPhone view").Range("A2") = Sheets("Routine").Range("B9") Then
      ...etc
End If

You can also replace your sheets with worksheet variables, which will reduce the amount of typing you have to do (also reducing the length of your code).

您还可以用工作表变量替换您的表，这将减少您必须要做的输入的数量(同时减少代码的长度)。

For example:

例如:

    Dim wb As Workbook
    Dim iphone As Worksheet
    Dim routine As Worksheet

    Set wb = ThisWorkbook
    Set iphone = wb.Sheets("iPhone view")
    Set routine = wb.Sheets("Routine")

    ' now we don't have to specify the sheet each time, so instead of this:
    ElseIf Sheets("iPhone view").Range("A2") = Sheets("Routine").Range("B10") Then

    ' we can use this shorter version:
    If iphone.Range("A2") = routine.Range("B10") Then

But by far the biggest bang for your buck will be replacing your if statements with a loop using a variable.

但到目前为止，最大的一笔开销将是用一个变量替换你的if语句。

As you point out in your comment, "Where x=9-29" can be written like this:

正如你在评论中指出的，“x=9-29”可以这样写:

Dim myRow As Integer

For myRow = 9 To 29
    ' do stuff, replacing "x" with myRow
Next myRow

Putting it all together, you can nest two loops, one for the column that increases, and the other for the range of rows that you are processing for each column.

将它们放在一起，可以嵌套两个循环，一个用于增加列，另一个用于为每个列处理的行范围。

Try this:

试试这个:

Sub ReplaceElseIfWithLoops()
    Dim wb As Workbook
    Dim iphone As Worksheet
    Dim routine As Worksheet
    Dim myRow As Integer
    Dim myCol As Integer

    Set wb = ThisWorkbook
    Set iphone = wb.Sheets("iPhone view")
    Set routine = wb.Sheets("Routine")

    For myCol = 3 To 39 ' column C = 3 and AM = 39
        If iphone.Range("A3") = routine.Cells(7, myCol) Then
            For myRow = 9 To 29
                If iphone.Range("A2") = routine.Range("B" & myRow) Then
                    routine.Range(Cells(myRow, myCol), Cells(myRow, myCol + 1)).Value = iphone.Range("A5:B5").Value 
                End If
            Next myRow

        End If
    Next myCol

End Sub

Note that you don't have to select the target sheet before pasting. In fact, selecting and activating things in your VBA code is almost always a really bad practice.

注意，在粘贴之前不需要选择目标表。实际上，在VBA代码中选择和激活东西几乎总是一种非常糟糕的实践。

#1