如何使大范围的联合范围更快 [英] how to make union range faster for large loops

问题描述

我有一个子，在循环中经过约5000次迭代后，它变得非常慢.否则很快.

I have a sub that becomes very slow after about 5000 iterations in a loop. It's quick otherwise.

Windows 8.1 Pro 64位

Windows 8.1 Pro 64 bit

Excel 2013(15.0.4701.1001)MSO(15.0.4701.1000)64位

Excel 2013 (15.0.4701.1001) MSO (15.0.4701.1000) 64-bit

Sub UnionSlow()

Dim ColArray() As Variant
Dim NumLastRow, NumRow, Cnt As Long
Dim CurCell As String
Dim rngPRC As Range

'Set an arbitrary row so range is not empty

Set rngPRC = Rows(1)

'Get the total number of rows in the sheet 

TotalRows = Rows(Rows.Count).End(xlUp).Row

'Load the first column into an array (v quick)

ColArray = Range(Cells(1, 1), Cells(TotalRows, 1)).Value

'Now loop through the array and add ROWS to the RANGE depending on a condition

For NumRow = 1 To TotalRows

       CurCell = ColArray(NumRow, 1)

       If CurCell = "PRC" Then Set rngPRC = Union(rngPRC, Rows(NumRow))

Next NumRow

'Display a few things

MsgBox "Areas count " & rngPRC.Areas.Count
MsgBox "Address " & rngPRC.Address
MsgBox "Length array " & UBound(ColArray) & " items"

rngPRC.EntireRow.Font.Color = RGB(0, 0, 128)

End Sub

所以，这是非常快速的加载数组并非常快速地更改颜色的事情.减慢速度的原因是建立行范围.多达2000行，速度很快(不到1秒)多达5000行的速度较慢(约5秒)在大约20000行中，大约需要10分钟

So the thing is that this loads the array very quickly and changes the color very quickly. What slows it down is building the range of rows. Up to 2000 rows it's quick (less than 1 second) Up to 5000 rows it's slower (about 5 seconds) At about 20000 rows it takes about 10 minutes

我是VBA的新手，请告诉我我是否在这里呆了.

I'm very new to VBA so please tell me if I'm being daft here.

感谢您的关注安东尼

推荐答案

我同意其中一项评论，指出自动过滤器在这种情况下会很好地工作.这是解决方案的草稿:

I agree with one of the comments stating that autofilter would work well in this situation. Here is a draft solution:

AutoFilterMode = False
TotalRows = Rows(Rows.Count).End(xlUp).Row
Set rngPRC = Range(Cells(1, 1), Cells(TotalRows, 1))

rngPRC.AutoFilter field:=1, Criteria1:="PRC"

If rngPRC.SpecialCells(xlCellTypeVisible).Count > 1 Then 'check if rows exist

  Set rngPRC = rngPRC.Resize(rngPRC.Rows.Count - 1, 1).Offset(1, 0) _
         .SpecialCells(xlCellTypeVisible).EntireRow

  'perform your operations here:  
  rngPRC.Font.Color = RGB(0, 0, 128)
End If

AutoFilterMode = False

这篇关于如何使大范围的联合范围更快的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！