VBA 程序太大；运行子程序时遇到问题答案

【问题标题】：VBA Procedure too large; having trouble running a sub procedureVBA 程序太大；运行子程序时遇到问题
【发布时间】：2020-12-02 05:13:56
【问题描述】：

我已将 Excel 工作表分成不同的部分，每个部分大小为 20 行（例如：第 1 部分 = 第 132 到 152 行，第 2 部分 = 第 153 到 173 行等）。有100个部分。我在 VBA 中运行一个过程，对于每个部分，将根据每个部分所需的行数隐藏一定数量的行。在 23 个部分运行例程后，我收到“程序太大”错误。我被告知我应该运行一个子程序来解决这个问题。我不知道该怎么做。我正在使用 Sub proc1()，但它不起作用。这是代码的第一部分，然后是 Sub proc1()。它不工作。我现在在 Sup proc1() 行之后立即收到以下错误：

检测到不明确的名称：Worksheet_Change

如果有人可以帮助我在 Sub proc1() 之后使用正确的代码，那将非常有帮助！

Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect
ActiveSheet.Activate
If Not Application.Intersect(Range("G20"), Range(Target.Address)) Is Nothing Then
Select Case Target.Value
Case Is = "0":  Rows("132:152").EntireRow.Hidden = True
Case Is = "1":  Rows("134:152").EntireRow.Hidden = True
                Rows("123:133").EntireRow.Hidden = False
Case Is = "2":  Rows("135:152").EntireRow.Hidden = True
                Rows("123:134").EntireRow.Hidden = False
Case Is = "3":  Rows("136:152").EntireRow.Hidden = True
                Rows("123:135").EntireRow.Hidden = False
Case Is = "4":  Rows("137:152").EntireRow.Hidden = True
                Rows("123:136").EntireRow.Hidden = False
Case Is = "5":  Rows("138:152").EntireRow.Hidden = True
                Rows("123:137").EntireRow.Hidden = False
Case Is = "6":  Rows("139:152").EntireRow.Hidden = True
                Rows("123:138").EntireRow.Hidden = False
Case Is = "7":  Rows("140:152").EntireRow.Hidden = True
                Rows("123:139").EntireRow.Hidden = False
Case Is = "8":  Rows("141:152").EntireRow.Hidden = True
                Rows("123:140").EntireRow.Hidden = False
Case Is = "9":  Rows("142:152").EntireRow.Hidden = True
                Rows("123:141").EntireRow.Hidden = False
Case Is = "10":  Rows("143:152").EntireRow.Hidden = True
                Rows("123:142").EntireRow.Hidden = False
Case Is = "11":  Rows("144:152").EntireRow.Hidden = True
                Rows("123:143").EntireRow.Hidden = False
Case Is = "12":  Rows("145:152").EntireRow.Hidden = True
                Rows("123:144").EntireRow.Hidden = False
Case Is = "13":  Rows("146:152").EntireRow.Hidden = True
                Rows("123:145").EntireRow.Hidden = False
Case Is = "14":  Rows("147:152").EntireRow.Hidden = True
                Rows("123:146").EntireRow.Hidden = False
Case Is = "15":  Rows("148:152").EntireRow.Hidden = True
                Rows("123:147").EntireRow.Hidden = False
Case Is = "16":  Rows("149:152").EntireRow.Hidden = True
                Rows("123:148").EntireRow.Hidden = False
Case Is = "17":  Rows("150:152").EntireRow.Hidden = True
                Rows("123:149").EntireRow.Hidden = False
Case Is = "18":  Rows("151:152").EntireRow.Hidden = True
                Rows("123:150").EntireRow.Hidden = False
Case Is = "19":  Rows("152:152").EntireRow.Hidden = True
                Rows("123:151").EntireRow.Hidden = False
Case Is = "20":  Rows("123:152").EntireRow.Hidden = False

End Select
End If

等等……然后：

If Not Application.Intersect(Range("G43"), Range(Target.Address)) Is Nothing Then
Select Case Target.Value
                    
Case Is = "0": Rows("615:635").EntireRow.Hidden = True
Case Is = "1": Rows("617:635").EntireRow.Hidden = True
    Rows("615:616").EntireRow.Hidden = False
Case Is = "2": Rows("618:635").EntireRow.Hidden = True
    Rows("615:617").EntireRow.Hidden = False
Case Is = "3": Rows("619:635").EntireRow.Hidden = True
    Rows("615:618").EntireRow.Hidden = False
Case Is = "4": Rows("620:635").EntireRow.Hidden = True
    Rows("615:619").EntireRow.Hidden = False
Case Is = "5": Rows("621:635").EntireRow.Hidden = True
    Rows("615:620").EntireRow.Hidden = False
Case Is = "6": Rows("622:635").EntireRow.Hidden = True
    Rows("615:621").EntireRow.Hidden = False
Case Is = "7": Rows("623:635").EntireRow.Hidden = True
    Rows("615:622").EntireRow.Hidden = False
Case Is = "8": Rows("624:635").EntireRow.Hidden = True
    Rows("615:623").EntireRow.Hidden = False
Case Is = "9": Rows("625:635").EntireRow.Hidden = True
    Rows("615:624").EntireRow.Hidden = False
Case Is = "10": Rows("626:635").EntireRow.Hidden = True
    Rows("615:625").EntireRow.Hidden = False
Case Is = "11": Rows("627:635").EntireRow.Hidden = True
    Rows("615:626").EntireRow.Hidden = False
Case Is = "12": Rows("628:635").EntireRow.Hidden = True
    Rows("615:627").EntireRow.Hidden = False
Case Is = "13": Rows("629:635").EntireRow.Hidden = True
    Rows("615:628").EntireRow.Hidden = False
Case Is = "14": Rows("630:635").EntireRow.Hidden = True
    Rows("615:629").EntireRow.Hidden = False
Case Is = "15": Rows("631:635").EntireRow.Hidden = True
    Rows("615:630").EntireRow.Hidden = False
Case Is = "16": Rows("632:635").EntireRow.Hidden = True
    Rows("615:631").EntireRow.Hidden = False
Case Is = "17": Rows("633:635").EntireRow.Hidden = True
    Rows("615:632").EntireRow.Hidden = False
Case Is = "18": Rows("634:635").EntireRow.Hidden = True
    Rows("615:633").EntireRow.Hidden = False
Case Is = "19": Rows("635:635").EntireRow.Hidden = True
    Rows("615:634").EntireRow.Hidden = False
Case Is = "20": Rows("615:635").EntireRow.Hidden = False
                    
End Select
End If

Call proc1
Call proc2

End Sub

Sub proc1()


If Not Application.Intersect(Range("G44"), Range(Target.Address)) Is Nothing Then
Select Case Target.Value
                    
Case Is = "0": Rows("636:656").EntireRow.Hidden = True
Case Is = "1": Rows("638:656").EntireRow.Hidden = True
    Rows("636:637").EntireRow.Hidden = False
Case Is = "2": Rows("639:656").EntireRow.Hidden = True
    Rows("636:638").EntireRow.Hidden = False
Case Is = "3": Rows("640:656").EntireRow.Hidden = True
    Rows("636:639").EntireRow.Hidden = False
Case Is = "4": Rows("641:656").EntireRow.Hidden = True
    Rows("636:640").EntireRow.Hidden = False
Case Is = "5": Rows("642:656").EntireRow.Hidden = True
    Rows("636:641").EntireRow.Hidden = False
Case Is = "6": Rows("643:656").EntireRow.Hidden = True
    Rows("636:642").EntireRow.Hidden = False
Case Is = "7": Rows("644:656").EntireRow.Hidden = True
    Rows("636:643").EntireRow.Hidden = False
Case Is = "8": Rows("645:656").EntireRow.Hidden = True
    Rows("636:644").EntireRow.Hidden = False
Case Is = "9": Rows("646:656").EntireRow.Hidden = True
    Rows("636:645").EntireRow.Hidden = False
Case Is = "10": Rows("647:656").EntireRow.Hidden = True
    Rows("636:646").EntireRow.Hidden = False
Case Is = "11": Rows("648:656").EntireRow.Hidden = True
    Rows("636:647").EntireRow.Hidden = False
Case Is = "12": Rows("649:656").EntireRow.Hidden = True
    Rows("636:648").EntireRow.Hidden = False

....and so on

【问题讨论】：

标签： vba process

【解决方案1】：

您可以使用循环和一些数学运算来大大减少您的代码：

Private Sub Worksheet_Change(ByVal Target As Range)

    Const BLOCK_SIZE As Long = 20 '(+1 header)

    Dim n As Long, i As Long, rngCheck As Range, c As Range, rStart As Long

    Me.Unprotect 'use Me to refer to the sheet itself

    Set rngCheck = Me.Range("G20") 'first cell to check
    rStart = 132                   'start row (header) for section 1

    For i = 1 To 100
        
        Set c = Application.Intersect(rngCheck, Target) 'Target intersects with cell being checked?
        If Not c Is Nothing Then
            n = c.Value
            If n > BLOCK_SIZE Then n = BLOCK_SIZE                    'limit number of rows to show
            Me.Cells(rStart, 1).Resize(BLOCK_SIZE + 1).EntireRow.Hidden = True       'hide all
            If n > 0 Then Me.Cells(rStart, 1).Resize(n + 1).EntireRow.Hidden = False 'unhide the ones we want
        End If

        Set rngCheck = rngCheck.Offset(1, 0) 'next cell to check
        rStart = rStart + (BLOCK_SIZE + 1)   'next block starting row

    Next i

End Sub

【讨论】：

感谢您的帮助！效果很棒！运行例程后，我添加了一些代码来再次保护工作表。你是救生员……谢谢！
最后一个问题：代码运行良好...但是如果我将单元格 G20 中的值复制到下面的所有其他单元格（G21 到 G119），我会收到错误：运行时错误13' 类型不匹配。然后当我尝试调试时，它以黄色突出显示代码中的行：n = Target.Value 无论如何允许将数字复制到多个这样的单元格......或者这是我可以的限制'不避免？
您是否需要它来响应一次编辑中更新的多个单元格？请参阅上面的编辑。