在某个范围内执行公式有问题



我从这个站点获得了这个宏,但是在运行它后,行为异常。宏运行良好,删除所有空白,空行和列,但是运行后,我有问题执行其他公式,例如范围内的负号。

我的代码

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

相关内容

最新更新