Excel VBA运行越来越慢，怎么提速

我看出问题了，数据多的时候，隐藏的 *** 作会很慢。加快速度有两个途径：

第一个简单点，for i=11 ti h的循环不要检查cells，而是先把第5列内容存放在数组里面，在数组里面检查是否应当隐藏。进行隐藏的算法也优化了一点，就是先根据是否相等判断出是否隐藏到变量x里面，然后检测那一行的状态是否与x相同，不同才处理，减少处理次数。优化后的代码如下：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim s, h, i, arr, x

    If Target.Address = Range("P5").Address Then

        s = Range("P5").Value

        h = UsedRange.Rows.Count

        If (Trim(s) = "全部" Or Trim(s) = "") Then

            Rows("10:" & h).Hidden = False

        Else

            Application.ScreenUpdating = False

            arr = Range(Cells(1, 5), Cells(h, 5))

            For i = 11 To h

                x = arr(i, 1) <> s

                If Rows(i).Hidden <> x Then Rows(i).Hidden = x

            Next

        Application.ScreenUpdating = True

        End If

    End If

End Sub

上面的代码通过从数组里面判断，减少了取数时间，隐藏/显示行之前先检测一下状态，减少处理时间，应该有一定的效果。

代码还可以进一步优化，逐行扫描去隐藏和显示的 *** 作仍然非常耗时，进一步优化的思路就是一块一块的进行处理，例如在数万行中筛选出需要显示的只有几行（极端就是一行）而其它都要显示的时候，最最佳状态下只需要执行三次：前面一段隐藏、中间一段显示、后面一段隐藏，能把上万次的表格界面 *** 作缩小到三次，效果会大大加强。但是代码会很长、很复杂，要用一系列变量记录判断的当前行应该隐藏还是显示，但不立即处理，继续判断下一行；如果需要的处理和前面的相同，就记录需要处理的范围，继续下一行判断；如果需要的处理和之前的不同，那就执行之前的 *** 作，重新记录。

1、首先在电脑桌面中，鼠标右键鼠标，新建一个excel工作簿并打开。

2、创建一个简单的表格，并输入一些字符串，比如衣服购买表格，如下图所示。

3、接着，鼠标左键单击【开发工具】菜单标签，并单击VBA按钮，如下图所示。

4、然后，在VBA编辑的代码窗口中，鼠标右键单击表格，选择添加用户窗体，如下图所示。

5、接着，在用户窗体上，选择工具箱中的【按钮】，如下图所示。

6、接着，鼠标右键选择【添加代码】，在代码窗口上，输入VBA代码，比如读取表格中的数据，给出消息提示，如下图所示。

7、最后，在设计窗口上，鼠标左键单击用户窗体上的按钮，可以看到表格中提示读取表格中数据的提示，如下图所示。

你这个算法确实太慢，双重循环反复在提取EXCEL表格数据，EXCEL提取数据是非常慢的，一般的思路是定义一个数组，一次性把表格的数据提取到数组里面，查询数组中的数据就非常快了。

另外，你的代码总是在设置单元格颜色，这个也很慢，而且没办法优化，建议数据增加一列，程序把计算结果填入这列，然后使用条件格式控制单元格的格式，这样优化就彻底了。

由于各段代码有类似性，我下面以模块1的代码块1位例子，给出使用数组进行优化例子，希望你能理解和举一反三。

优化后代码的文本如下，有可能排版会乱，建议结合上图阅读。

  Dim arr1, arr2, i, j '定义两个数组

  arr1 = Sheet1.UsedRange.Resize(, 1) '一次性提取表1数据A列

  arr2 = sheet2.UsedRange.Resize(, 1) '一次性提取表2数据A列

  Sheet1.UsedRange.Resize(, 1).Interior.Color = xlNone '所有已经使用空间的第一列

  For i = 1 To UBound(arr1) '对表1A列所有数据进行检查

      If arr1(i, 1) <>"" Then '如果它非空

          For j = 1 To UBound(arr2) '查看是否包含表2A列的某一行

              If InStr(arr1(i, 1), arr2(j, 1)) Then

                  Sheet1.Cells(i, 1).Interior.Color = 10000 '这个语句仍然影响速度

                  Exit For '一旦标记就不再继续扫描表2

              End If

          Next j

      End If

  Next i

---