如何更快地创建此VBA，删除空白单元格

Question

此VBA阵列可以工作并删除我想要的所有空白。但它一直延伸到像第一排一样，占用了宝贵的计算机资源。如果“数组中的下10行没有填充数据”，我需要让VBA停止。或者我只需要它停在第2000行。它扫描I1：K2000＆amp;数据显示在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...位之前将其粘在顶部。

Parent的{​​{1}}是Range个对象。 Worksheet维护一个名为Worksheet的属性，该属性包含所有具有数据或格式或与默认空白单元格不同的单元格。它在整张纸上翻了一个角落。