"程序太大"错误

Question

"程序太大"错误

Sub Create_Mail_From_List_Exams()

Dim OutApp  As Object
Dim OutMail As Object
Dim cell As Range
Dim bodymessage  As String
Dim bodymessage1 As String
Dim bodymessage2 As String
Dim bodymessage3 As String
Dim bodymessage4  As String
Dim bodymessage5 As String
Dim Bodymessage6 As String
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup
Dim i As Integer
Dim j As Integer
For i = 3 To ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

    bodymessage = ""
    bodymessage1 = ""
    bodymessage2 = ""
    bodymessage3 = ""
    bodymessage4 = ""
    bodymessage5 = ""
    ex6 = ""
    ex7 = ""
    ex8 = ""

    fr1 = ""
    fr2 = ""
    fr3 = ""
    fr4 = ""
    fr5 = ""
    fr6 = ""
    fr7 = ""
    fr8 = ""
    fr9 = ""

  'ActiveSheet.Cells(1, 12) = ActiveSheet.Cells(1, 12) & "(" & cell.Row & "," & cell.Column & "), "

    If Sheets("Exams-email results").Cells(i, 3).Text Like "?*@?*.?*" And _
    LCase(Cells(i, "M").Value) = "dnm" Then

    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail

    .To = ActiveSheet.Cells(i, 3).Text



    .Subject = Sheets("Exams-email results").Range("T2") & " / " & Sheets("Exams-email results").Range("T5")


    '& "Groupe  " & ActiveSheet.Cells(i, 10).Text & "  / Niveau " & ActiveSheet.Cells(i, 11).Text'

    'A'

    If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "Educ" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B7").Text
    End If


    If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "A1" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B26").Text

    End If

      If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "A2" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B27").Text

    End If

           If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "A3" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B28").Text

    End If
        If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "A4" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B29").Text

    End If
    If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "A5" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B30").Text

    End If

         If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "A6" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B31").Text

    End If

         If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "A7" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B32").Text

    End If

         If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "A8" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B33").Text

    End If

         'k'

         If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "K1" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B20").Text

    End If

         If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "K2" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B21").Text

    End If
            If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D2").Text = "K3" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B22").Text

    End If


            If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "K4" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B23").Text

    End If


            If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "K5" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B24").Text

    End If



           'PS'




     If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "PS1" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B35").Text
    End If




     If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "PS2" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B36").Text
    End If



         If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "PS3" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B37").Text
    End If

         If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "PS4" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B38").Text
    End If

         If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "PS5" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B39").Text
    End If

         If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "PS6" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B40").Text
    End If

         If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "PS7" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B41").Text
    End If

         If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "PS8" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B42").Text
    End If





    'EXAM2'



        If LCase(Cells(i, "E").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "Educ" Then

        bodymessage1 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B7").Text
    End If


        If LCase(Cells(i, "E").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "A1" Then

        bodymessage1 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B26").Text
    End If


        If LCase(Cells(i, "E").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "A2" Then

        bodymessage1 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B27").Text
    End If


        If LCase(Cells(i, "E").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "A3" Then

        bodymessage1 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B28").Text
    End If


        If LCase(Cells(i, "E").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "A4" Then

        bodymessage1 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B29").Text
    End If


        If LCase(Cells(i, "E").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "A5" Then

        bodymessage1 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B30").Text
    End If


        If LCase(Cells(i, "E").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "A6" Then

        bodymessage1 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B31").Text
    End If
        If LCase(Cells(i, "E").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "A7" Then

        bodymessage1 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B32").Text
    End If
     If LCase(Cells(i, "E").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "A8" Then

        bodymessage1 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B33").Text
    End If






    'k'


        If LCase(Cells(i, "E").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "K1" Then

        bodymessage1 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B20").Text
    End If





     If LCase(Cells(i, "E").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "K2" Then

        bodymessage1 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B21").Text
    End If



    If LCase(Cells(i, "E").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "K3" Then

        bodymessage1 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B22").Text
    End If


    If LCase(Cells(i, "E").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "K4" Then

        bodymessage1 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B23").Text
    End If

    If LCase(Cells(i, "E").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "K5" Then

        bodymessage1 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B24").Text
    End If

    'ps1'


    If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS1" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B35").Text
    End If

    If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS2" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B36").Text
    End If

    If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS3" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B37").Text
    End If

    If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS4" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B38").Text
    End If

    If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS5" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B39").Text
    End If

    If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS6" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B40").Text
    End If

    If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS7" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B41").Text
    End If

    If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS8" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B42").Text
    End If





    'Exam3'



        If LCase(Cells(i, "F").Text) = "dnm" And Sheets("Exams-email results").Range("F3").Text = "Educ" Then

        bodymessage2 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B7").Text
    End If


        If LCase(Cells(i, "F").Text) = "dnm" And Sheets("Exams-email results").Range("F3").Text = "A1" Then

        bodymessage2 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B26").Text
    End If


        If LCase(Cells(i, "F").Text) = "dnm" And Sheets("Exams-email results").Range("F2").Text = "A2" Then

        bodymessage2 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B27").Text
    End If


        If LCase(Cells(i, "F").Text) = "dnm" And Sheets("Exams-email results").Range("F2").Text = "A3" Then

        bodymessage2 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B28").Text
    End If


        If LCase(Cells(i, "F").Text) = "dnm" And Sheets("Exams-email results").Range("F2").Text = "A4" Then

        bodymessage2 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B29").Text
    End If


        If LCase(Cells(i, "F").Text) = "dnm" And Sheets("Exams-email results").Range("F2").Text = "A5" Then

        bodymessage2 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B30").Text
    End If


        If LCase(Cells(i, "F").Text) = "dnm" And Sheets("Exams-email results").Range("F2").Text = "A6" Then

        bodymessage2 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B31").Text
    End If

        If LCase(Cells(i, "F").Text) = "dnm" And Sheets("Exams-email results").Range("F2").Text = "A7" Then

        bodymessage2 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B32").Text
    End If

     If LCase(Cells(i, "F").Text) = "dnm" And Sheets("Exams-email results").Range("F2").Text = "A8" Then

        bodymessage2 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B33").Text
    End If





    'K'


        If LCase(Cells(i, "F").Text) = "dnm" And Sheets("Exams-email results").Range("F3").Text = "K1" Then

        bodymessage2 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B20").Text
    End If

    If LCase(Cells(i, "F").Text) = "dnm" And Sheets("Exams-email results").Range("F3").Text = "K2" Then

        bodymessage2 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B21").Text
    End If
    If LCase(Cells(i, "F").Text) = "dnm" And Sheets("Exams-email results").Range("F3").Text = "K3" Then

        bodymessage2 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B22").Text
    End If

    If LCase(Cells(i, "F").Text) = "dnm" And Sheets("Exams-email results").Range("F3").Text = "K4" Then

        bodymessage2 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B23").Text
    End If

    If LCase(Cells(i, "F").Text) = "dnm" And Sheets("Exams-email results").Range("F3").Text = "K5" Then

        bodymessage2 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B24").Text
    End If

    'PS'


    If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS1" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B35").Text
    End If
    If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS2" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B36").Text
    End If
    If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS3" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B37").Text
    End If
    If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS4" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B38").Text
    End If
    If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS5" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B39").Text
    End If
    If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS6" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B40").Text
    End If
    If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS7" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B41").Text
    End If

    If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS8" Then

        bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B42").Text
    End If




    'EXam'



        If LCase(Cells(i, "G").Text) = "dnm" And Sheets("Exams-email results").Range("G3").Text = "Educ" Then

        bodymessage3 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B7").Text
    End If


        If LCase(Cells(i, "G").Text) = "dnm" And Sheets("Exams-email results").Range("G3").Text = "A1" Then

        bodymessage3 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B26").Text
    End If


        If LCase(Cells(i, "G").Text) = "dnm" And Sheets("Exams-email results").Range("G3").Text = "A2" Then

        bodymessage3 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B27").Text
    End If


        If LCase(Cells(i, "G").Text) = "dnm" And Sheets("Exams-email results").Range("G3").Text = "A3" Then

        bodymessage3 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B28").Text
    End If


        If LCase(Cells(i, "G").Text) = "dnm" And Sheets("Exams-email results").Range("G3").Text = "A4" Then

        bodymessage3 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B29").Text
    End If


        If LCase(Cells(i, "G").Text) = "dnm" And Sheets("Exams-email results").Range("G3").Text = "A5" Then

        bodymessage3 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B30").Text
    End If


        If LCase(Cells(i, "G").Text) = "dnm" And Sheets("Exams-email results").Range("G3").Text = "A6" Then

        bodymessage3 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B31").Text
    End If
        If LCase(Cells(i, "G").Text) = "dnm" And Sheets("Exams-email results").Range("G3").Text = "A7" Then

        bodymessage3 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B32").Text
    End If

     If LCase(Cells(i, "G").Text) = "dnm" And Sheets("Exams-email results").Range("G3").Text = "A8" Then

        bodymessage3 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B33").Text
End If

Run Code Online (Sandbox Code Playgroud)

Answer 1

Sid*_*out 6

做到这一点,一切都会好起来的.

而不是如下所示有这么多变量

Dim bodymessage  As String
Dim bodymessage1 As String
Dim bodymessage2 As String
Dim bodymessage3 As String
Dim bodymessage4  As String
Dim bodymessage5 As String
Dim Bodymessage6 As String

Run Code Online (Sandbox Code Playgroud)

使用数组.例如

Dim bodymessage(1 to 7) as String

Run Code Online (Sandbox Code Playgroud)

删除不必要的空行并删除不必要的注释.

例如,这6行

fr1 = ""
fr2 = ""
fr3 = ""
fr4 = ""
fr5 = ""
fr6 = ""
fr7 = ""
fr8 = ""
fr9 = ""

Run Code Online (Sandbox Code Playgroud)

可以写成2行

fr1 = "": fr2 = "": fr3 = "": fr4 = "": fr5 = ""
fr6 = "": fr7 = "": fr8 = "": fr9 = ""

Run Code Online (Sandbox Code Playgroud)

这只是一个例子.在上面的例子中,我将完全按照我在第1点中提到的那样做.使用数组.

还有一点.您无需单独清除阵列的每个元素.你可以用Erase MyAr.这是一个例子

Sub Sample()
    Dim MyAr(1 To 5)

    For i = 1 To 5
        MyAr(i) = 1
    Next i

    For i = 1 To 5
        Debug.Print MyAr(i)
    Next i

    Erase MyAr

    For i = 1 To 5
        Debug.Print MyAr(i) '<~~ Nothing there
    Next i

    Debug.Print UBound(MyAr)
End Sub

Run Code Online (Sandbox Code Playgroud)

你在重复If LCase(Cells(i, "D").Text) = "dnm".只使用一次并将其余的if语句放入其中并将其转换为Select Case.例如

If LCase(Cells(i, "D").Text) = "dnm" Then
    Select Case Sheets("Exams-email results").Range("D3").Text
    Case "Educ": bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B7").Text
    Case "A1": bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B26").Text
    Case "A2": bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B27").Text
    '
    '~~> And so on
    '
    End Select
End If

Run Code Online (Sandbox Code Playgroud)

如果您应用我上面提到的所有内容,那么您的错误将消失:)总是尝试编写清晰而精确的代码:)

@BruceWayne它与bodymessage数组的格式相同 - fr(i)= fr组的第i个元素. (2认同)
您可以使用变量变量,但在此方案中过于复杂而不需要.你可以在`fr`的情况下使用数组.所以就像`Dim fri(1 to 9)`并在其中存储值,如`fri(1)="Blah Blah"`并清除你不必做的数组`fr(1)="":fr (2)=""`等等...你可以使用`Erase fr`在一行中清除它@BruceWayne (2认同)
++好的...我会更进一步,将"考试 - 电子邮件结果"和相应的"SOMC-Legend"范围名称放在二维数组中.这会将所有那些`SELECT CASE`语句进一步缩小为一行或两行:) (2认同)
谢谢@ Grade'Eh'Bacon和Siddharth!我知道这对你来说太复杂了,但你的回答提示了这个问题,很高兴知道! (2认同)
@PradeepKumar:你到底在这些神秘的时刻保持清醒:D是的,这也是一个很好的建议. (2认同)

归档时间：	10 年，3 月前
查看次数：	55 次
最近记录：	10 年，3 月前