我如何使这个VBA更快，删除空白单元格

Question

这个VBA数组工作并删除我想要的所有空白。但是它一直延伸到第100万行，占用了宝贵的计算机资源。我需要要么使VBA停止，如果"数组中的下10行没有填满数据"，或者我只需要它停止在第2000行。它扫描I1:K2000 &数据显示在"M1:O2000"。

Function NonBlanks(DataRange As Variant) As Variant
Dim i As Long, J As Long, NumRows As Long, NumCols As Long, RtnA() As Variant
Dim RtnRow As Long
Application.ScreenUpdating = 0
If TypeName(DataRange) = "Range" Then DataRange = DataRange.Value2
NumRows = UBound(DataRange)
NumCols = UBound(DataRange, 2)
ReDim RtnA(1 To NumRows, 1 To NumCols)
For i = 1 To NumRows
If DataRange(i, 1) <> "" Then
RtnRow = RtnRow + 1
For J = 1 To NumCols
If DataRange(i, J) <> "" Then RtnA(RtnRow, J) = DataRange(i, J) _
Else RtnA(RtnRow, J) = ""
Next J
  End If
Next i
For i = RtnRow + 1 To NumRows
For J = 1 To NumCols
RtnA(i, J) = ""
Next J
Next i
NonBlanks = RtnA
Application.ScreenUpdating = 1
End Function

Answer 1

假设DataRange是一个有效的Range对象，您可以使用

快速限制范围的大小。

Set DataRange = Intersect(DataRange.Parent.UsedRange, DataRange)

在你做If TypeName...位之前把它放在顶部。

Range的Parent是Worksheet对象。Worksheet维护一个名为UsedRange的属性，该属性包含所有具有数据或格式或与默认空白单元格不同的单元格。它比在整张纸上一个角到另一个角的移动要好。