VBA 编译错误：过程太长

Question

如何缩短此代码？请原谅我的不良编码习惯，我是自学成才，几乎是个菜鸟。

代码由 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") 其中 x= 9-29

Sheets("Routine").Range("C7")，此范围更改为 G7,K7,O7,S7,...AM7。当上面到达B29时

Range("C9:D9").Select 的列字母随上面的变化而变化，行号也是如此

所以我基本上可以做这样的事情？

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

Answer 1

您可以做几件事。首先，您似乎在每个 if 语句中检查以下内容：

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

您只需运行一次该测试，直到“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

您还可以用工作表变量替换您的工作表，这将减少您必须输入的数量（也减少了代码的长度）。

例如：

    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

但到目前为止，最大的收获是用使用变量的循环替换 if 语句。

正如您在评论中指出的那样，“其中 x=9-29”可以这样写：

Dim myRow As Integer

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

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

试试这个：

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

请注意，您不必在粘贴前选择目标工作表。事实上，在 VBA 代码中选择和激活东西几乎总是一种非常糟糕的做法。