在某個範圍內執行公式時出現問題

Question

我從這個站點獲得了這個宏，但運行後似乎表現異常。宏運行良好，並刪除所有的空白和空的行和列，但運行後，我有問題執行其他公式，如在範圍內加減。

我的代碼：

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 

Answer 1

簡明代碼：

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