[英]Macro works but too slow
我发现这个宏可以完成这项工作,但执行需要很长时间。 我希望 go 在第 4 到 350 行而不是所有行上。 另外,我希望它不要询问哪个工作表,而是在工作表名称 Data 上执行。 该宏用于删除空行。
Sub DeleteBlankRows()
Dim wks As Worksheet
Dim lngLastRow As Long, lngLastCol As Long, lngIdx As Long, _
lngColCounter As Long
Dim blnAllBlank As Boolean
Dim UserInputSheet As String
UserInputSheet = Application.InputBox("Enter the name of the sheet which you wish to remove empty rows from")
Set wks = Worksheets(UserInputSheet)
With wks
'Now that our sheet is defined, we'll find the last row and last column
lngLastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
lngLastCol = .Cells.Find(What:="*", LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
'Since we need to delete rows, we start from the bottom and move up
For lngIdx = lngLastRow To 1 Step -1
'Start by setting a flag to immediately stop checking
'if a cell is NOT blank and initializing the column counter
blnAllBlank = True
lngColCounter = 2
'Check cells from left to right while the flag is True
'and the we are within the farthest-right column
While blnAllBlank And lngColCounter <= lngLastCol
'If the cell is NOT blank, trip the flag and exit the loop
If .Cells(lngIdx, lngColCounter) <> "" Then
blnAllBlank = False
Else
lngColCounter = lngColCounter + 1
End If
Wend
'Delete the row if the blnBlank variable is True
If blnAllBlank Then
.Rows(lngIdx).Delete
End If
Next lngIdx
End With
MsgBox "Blank rows have been deleted."
End Sub
如果该行中的所有单元格都是空白的,您似乎想要删除行。
您的实际代码检查数据范围中每一行和每一列的每个单元格。
您可以通过检查整行是否为空白来提高速度。 例如:
黄色单元格是空白单元格 红色单元格是完整的空白行(该行中的所有单元格都是空白)。
此代码将删除红色行,这意味着它将删除整行,但前提是所有单元格均为空白。
Dim rng As Range
Dim i As Long
Dim MyRow As Range, DeleteRange As Range
Dim MiF As WorksheetFunction
Set MiF = WorksheetFunction
Set rng = Range("C7:M34") 'define range here
For i = 1 To rng.Rows.Count
If MiF.CountA(rng.Rows(i)) = 0 Then
If DeleteRange Is Nothing Then
Set DeleteRange = rng.Rows(i) 'first time, we can't use Union
Else
'we unite all complete blank rows into one final "big" range
Set DeleteRange = Union(DeleteRange, rng.Rows(i))
End If
End If
Next i
'we delete if something is found
If Not DeleteRange Is Nothing Then DeleteRange.EntireRow.Delete
'clear variables
Set DeleteRange = Nothing
Set rng = Nothing
Set MiF = Nothing
执行代码后output是这样的。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.