我从这个站点获得了这个宏,但是在运行它后,行为异常。宏运行良好,删除所有空白,空行和列,但是运行后,我有问题执行其他公式,例如范围内的负号。
我的代码:
Sub RemoveBlankRowsColumns()
'PURPOSE: Remove blank rows or columns contained in the spreadsheets UsedRange
Dim rng As Range
Dim rngDelete As Range
Dim RowCount As Long, ColCount As Long
Dim EmptyTest As Boolean, StopAtData As Boolean
Dim RowDeleteCount As Long, ColDeleteCount As Long
Dim x As Long
Dim UserAnswer As Variant
'Analyze the UsedRange
Set rng = ActiveSheet.UsedRange
rng.Select
RowCount = rng.Rows.Count
ColCount = rng.Columns.Count
DeleteCount = 0
'Optimize Code
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
'Loop Through Rows & Accumulate Rows to Delete
For x = RowCount To 1 Step -1
'Is Row Not Empty?
If Application.WorksheetFunction.CountA(rng.Rows(x)) <> 0 Then
If StopAtData = True Then Exit For
Else
If rngDelete Is Nothing Then Set rngDelete = rng.Rows(x)
Set rngDelete = Union(rngDelete, rng.Rows(x))
RowDeleteCount = RowDeleteCount + 1
End If
Next x
'Delete Rows (if necessary)
If Not rngDelete Is Nothing Then
rngDelete.EntireRow.Delete Shift:=xlUp
Set rngDelete = Nothing
End If
'Loop Through Columns & Accumulate Columns to Delete
For x = ColCount To 1 Step -1
'Is Column Not Empty?
If Application.WorksheetFunction.CountA(rng.Columns(x)) <> 0 Then
If StopAtData = True Then Exit For
Else
If rngDelete Is Nothing Then Set rngDelete = rng.Columns(x)
Set rngDelete = Union(rngDelete, rng.Columns(x))
ColDeleteCount = ColDeleteCount + 1
End If
Next x
'Delete Columns (if necessary)
If Not rngDelete Is Nothing Then
rngDelete.Select
rngDelete.EntireColumn.Delete
End If
'Refresh UsedRange (if necessary)
If RowDeleteCount + ColDeleteCount > 0 Then
ActiveSheet.UsedRange
End If
End Sub
凝结代码:
Sub RemoveBlankRowsColumns()
'PURPOSE: Remove blank rows or columns contained in the spreadsheets UsedRange
Dim RowCount As Long, ColCount As Long, x As Long
'Dim EmptyTest As Boolean, StopAtData As Boolean
Dim RowDeleteCount As Long: RowDeleteCount = 0
Dim ColDeleteCount As Long: ColDeleteCount = 0
Dim DeleteCount As Long: DeleteCount = 0
'Dim UserAnswer As Variant
On Error GoTo ExitSub
With ActiveSheet.UsedRange
RowCount = .Rows.Count
ColCount = .Columns.Count
'Optimize Code
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
'Loop Through Rows & Delete
For x = RowCount To 1 Step -1
'Is Row Not Empty?
If Application.WorksheetFunction.CountA(.Rows(x)) <> 0 Then
If StopAtData = True Then Exit For
Else
.Rows(x).EntireRow.Delete Shift:=xlUp
RowDeleteCount = RowDeleteCount + 1
End If
Next x
'Loop Through Columns & Delete
For x = ColCount To 1 Step -1
'Is Column Not Empty?
If Application.WorksheetFunction.CountA(.Columns(x)) <> 0 Then
If StopAtData = True Then Exit For
Else
.Columns(x).EntireColumn.Delete Shift:=xlLeft
ColDeleteCount = ColDeleteCount + 1
End If
Next x
DeleteCount = RowDeleteCount + ColDeleteCount
End With
ExitSub:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub