在所有工作表中只保留一个范围 - VBA

Question

我希望在所有工作中保留一个固定范围sheet，其余部分必须删除。当我运行我的代码时，它只适用于第一个 sheet，而其他 sheet 没有任何反应。

Sub ClearAllExceptSelection()

    Dim xRg As Range
    Dim xCell As Range
    Dim xAddress As String
    Dim xUpdate As Boolean
    On Error Resume Next

    xAddress = Application.ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Please select the ranges want to keep", "Input", xAddress, , , , , 8)
    If xRg Is Nothing Then Exit Sub

    xUpdate = Application.ScreenUpdating

    Application.ScreenUpdating = False
    For Each xCell In ActiveSheet.UsedRange
        If Intersect(xCell, xRg) Is Nothing Then
            xCell.Clear
        End If
    Next
    Application.ScreenUpdating = xUpdate

End Sub

Sub WorksheetLoop()

    Dim WS_Count As Integer
    Dim I As Integer

    ' Set WS_Count equal to the number of worksheets in the active workbook.
    WS_Count = ActiveWorkbook.Worksheets.Count

    ' Begin the loop.
    For I = 1 To WS_Count
        Call ClearAllExceptSelection
    Next I

End Sub

请帮我解决这个错误。

提前致谢。

Answer 1

我认为您正在寻找类似于以下代码的内容：

Option Explicit

Sub WorksheetLoop()

    Dim i As Long
    Dim xRg As Range
    Dim xCell As Range
    Dim xAddress As String

    ' first set the Exception Range
    xAddress = Application.ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Please select the ranges want to keep", "Input", xAddress, , , , , 8)
    If xRg Is Nothing Then Exit Sub

    Application.ScreenUpdating = False

    ' loop through worksheets
    For i = 1 To ThisWorkbook.Worksheets.Count
        ' ~~~ Call your Sub, pass the Worksheet and Range objects
        ClearAllExceptSelection ThisWorkbook.Worksheets(i), xRg
    Next i

    Application.ScreenUpdating = True

End Sub

'==============================================================

Sub ClearAllExceptSelection(Sht As Worksheet, xRng As Range)

    Dim xCell As Range
    Dim LocRng As Range

    Set LocRng = Sht.Range(xRng.Address) ' set the local sheet's range using the selected range address

    ' loop through Used range in sheet, and check if intersects with Exception range
    For Each xCell In Sht.UsedRange.Cells
        If Application.Intersect(xCell, LocRng) Is Nothing Then
            xCell.Clear
        End If
    Next xCell

End Sub

在所有工作表中只保留一个范围 - VBA

Keep only a range in all sheets - VBA

excel

vba

loops

worksheet