对于循环设置字体和范围的内部太长

我有一张有很多数据的表（差不多有14.000行和13列）。

我在这张表中运行一个For循环，但是有时候需要2分钟才能完成。 此外，应用程序在For循环中没有响应。

有没有办法我可以重新写我的循环，所以它会跑得快很多？

这是我的代码：

 For counter = 1 To Rows.Count If Cells(counter, 13).Value > 500 Then Cells(counter, 13).Interior.ColorIndex = 37 Cells(counter, 13).Font.Color = Black Cells(counter, 13).Font.Bold = True End If count = count + 1 Application.StatusBar = count Next counter 

提前致谢 ：）。

Answer 1

避免在范围内循环。 你可以通过遍历一个数组来加速你的代码，并在它之后进行格式化。 此外，你可以分割你的循环状态栏计数的部分。

码

 Option Explicit Public Sub Greater500() Dim ws As Worksheet Set ws = ThisWorkbook.Worksheets("MySheet") Dim v As Variant Dim i As Long, n As Long, m As Long, r As Long Dim t As Double ' stop watch t = timer ' get last row in column M n = ws.Range("M" & ws.Rows.Count).End(xlUp).Row ' get values to one based 2dim array v = ws.Range("M1:M" & n).value ' clear existing colors over the WHOLE column to minimize file size ws.Range("M:M").Interior.ColorIndex = xlColorIndexNone For i = 1 To n ' avoid troubles with formula errors, eg divisions :/ zero If IsError(v(i, 1)) Then ' check condition (neglecting date, string and boolean data types) ElseIf Val(v(i, 1)) > 500 Then ws.Cells(i, 13).Interior.ColorIndex = 37 ws.Cells(i, 13).Font.Color = vbBlack ws.Cells(i, 13).Font.Bold = True End If Next i MsgBox "Time needed: " & Format(timer - t, "0.00") & " seconds." End Sub 

Answer 2

Rows.Count包含每一行，而不仅仅是包含数据的行。 （Excel 2016中为1,048,576行 ）。 状态栏不应该减慢太多。

 Sub test() Dim c As Range, count As Integer Worksheets("Sheet1").Activate ActiveSheet.UsedRange.Select For Each c In Application.Selection.Cells If Cells(c.Row, 13).Value > 500 Then Cells(c.Row, 13).Interior.ColorIndex = 37 Cells(c.Row, 13).Font.Color = Black Cells(c.Row, 13).Font.Bold = True count = count + 1 End If Application.StatusBar = count Next c End Sub 

Answer 3

你的代码变慢的原因是当你写Rows.Count的时候它会占用所有的行。

尝试限制您的范围，并在应该解决您的问题的最后一次更新格式。

下面的代码需要50000个单元，并在我的机器上或多或less的8秒完成。

我也尝试了几乎相同的时间每个循环。

 Sub test() Dim counter As Long Dim count As Long Dim st As Double Dim et As Double Dim tottime As Double Dim rangetoformat As Range 'remove timer st = Timer For counter = 1 To 50000 If Not rangetoformat Is Nothing Then If Cells(counter, 13).Value > 500 Then Set rangetoformat = Union(rangetoformat, Cells(counter, 13)) End If Else Set rangetoformat = Cells(counter, 13) End If count = count + 1 Application.StatusBar = count Next counter rangetoformat.Cells.Interior.ColorIndex = 37 rangetoformat.Cells.Font.Color = Black rangetoformat.Cells.Font.Bold = True 'remove timer et = Timer totaltime = et - st MsgBox totaltime End Sub