如何使用FOR调用具有各自变量名的函数？

Question

我试图通过使其可读性和简洁性来改进我的代码。在名为“ModTest”的模块和名为“ABC”的Sheet1中，我有以下内容：

Sub Questionnaire_1()  ' ModTest
  ' do something
End Sub

Sub Questionnaire_2()  ' ModTest
  ' do something
End Sub

Sub Questionnaire_3()  ' ModTest
  ' do something
End Sub

Sub Questionnaire_4()  ' ModTest
  ' do something
End Sub

Sub Math() ' ModTest

         Dim Question As Integer 

         Question = Sheets("ABC").Range("G5").Value

         If Question = 0 Then

             ' do something

         Else
                Select Case Question

                    Case Is = 1
                        Call Questionnaire_1

                    Case Is = 2
                        Call Questionnaire_1
                        Call Questionnaire_2

                    Case Is = 3
                        Call Questionnaire_1
                        Call Questionnaire_2
                        Call Questionnaire_3

                    Case Is = 4
                        Call Questionnaire_1
                        Call Questionnaire_2
                        Call Questionnaire_3
                        Call Questionnaire_4
                 End Select
          End if
End Sub

但是，我不仅使用4个调查问卷，而且还有100个。我的意图是保留行[Sub Questionnaire_1（...）Sub Questionnaire_100]，但是通过消除选择来改进for命令中名为“Variable”的调用函数案件：

Sub Math()

Dim i, Question As Integer 
Dim Variable as String

Question = Sheets("ABC").Range("G5").Value

       If Question = 0 Then

         ' do something

       Else
           For i = 1 to Question

             Variable = "Questionnaire_" & i

             Call Variable
           Next i
       End if
 End Sub

有人可以帮忙吗？我收到以下“VBA编译错误：预期的子，功能或属性”。

---

多思考一下，有可能通过另一种解决方案绕过Select Case和Call功能，这种解决方案也起作用并且避免使用100个潜艇！通过新改进的跟进替换所有上述代码，如下：

Sub Questionnaire()  ' ModTest

Dim i, f, g, Question As Integer

Question = Sheets("ABC").Range("G5").Value

    If Question = 0 Then

         ' do something

    Else

        For i = 1 To Question

           f = 18 + 2 * i
           g = 19 + 2 * i

          With Worksheets("ABC")

             .Activate
             .Range("V2").Value = i
             .Range("X2").Value = "C"
             .Range("G2").Select
               Selection.Copy
             .Range("G" & f).Select
               Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
             .Range("G3").Select
               Selection.Copy
             .Range("H" & g).Select
               Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
             .Range("X2").Value = "I"
             .Range("L5").Select
               Selection.Copy
             .Range("L" & f).Select
               Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
             .Range("L6").Select
               Selection.Copy
             .Range("M" & g).Select
               Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

          End With

        Next i
   End If
End Sub

Answer 1

我怀疑这段代码可能适合你。请测试一下。

Option Explicit

Sub MathTest()
    ' 17 Dec 2017
    ' "Math" is a module of VBA. (For explanation, select and press F1)
    ' Its use as a procedure name may lead to unexpected results

    Dim Ws As Worksheet
    Dim i As Integer

    Set Ws = Worksheets("ABC")
    Application.ScreenUpdating = False
    ' this loop will not run if G5 < 1
    For i = 1 To Int(Val(Ws.Range("G5").Value))
        Questionnaire i, Ws
    Next i
    Application.ScreenUpdating = True
 End Sub

Private Sub Questionnaire(ByVal Q As Integer, _
                          Ws As Worksheet)
    ' 17 Dec 2017

    Const WhatsThis As Long = 18

    ' in the next line, all items are Variants except 'Question'
    ' Dim i, f, g, Question As Integer
    Dim RowG As Long
    Dim i As Long

    RowG = WhatsThis + (2 * Q)

    With Ws
        .Range("V2").Value = Q
        .Range("X2").Value = "C"

        For i = 0 To 1
            .Cells(RowG + i, "G").Value = .Cells(2 + i, "G").Value
        Next i
    End With
End Sub