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

Question

这个 VBA 数组有效并删除了我想要的所有空白。但它一直延伸到第 10 行，占用了宝贵的计算机资源。如果“数组中的下 10 行未填充数据”，我需要让 VBA 停止，或者我只需要它在第 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...。

ParentaRange是一个Worksheet对象。Worksheet维护一个名为的属性，该属性UsedRange包括所有具有数据或格式或与默认空白单元格不同的单元格。它胜过在整张纸上从一个角落到另一个角落。