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

有问题来执行范围内的公式

1 个答案: