Excel 在所有图纸中仅保留一个范围-VBA

我希望在所有工作表中保留一个固定的范围，其余部分必须删除。当我运行我的代码时，它只对第一个工作表有效，而在其他工作表上没有发生任何事情

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

请帮我解决这个错误

---

提前谢谢。

我想您想要的是下面的代码：

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

---

我想你想要的是下面的代码：

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

---

您只能使用

ActiveSheet

运行它。除了一张纸之外，你为什么还指望它能工作呢？这不是一个bug；代码正按照您的要求执行。@KenWhite我如何使其动态并在所有工作表中循环？通过访问

sheets（）

集合。在

for

循环中，已经有了一个索引。更改代码以访问该索引处的工作表。在本网站上搜索

[excel][vba]循环所有工作表

示例。@KenWhite有一个后续问题，如果我想首先定义范围并通过循环所有工作表使用它，我该如何做？感谢您在开始循环工作表之前预先定义它，并将其作为参数传递给清除范围的过程。您只能使用

ActiveSheet

运行它。除了一张纸之外，你为什么还指望它能工作呢？这不是一个bug；代码正按照您的要求执行。@KenWhite我如何使其动态并在所有工作表中循环？通过访问

sheets（）

集合。在

for

循环中，已经有了一个索引。更改代码以访问该索引处的工作表。在本网站上搜索

[excel][vba]循环所有工作表

示例。@KenWhite有一个后续问题，如果我想首先定义范围并通过循环所有工作表使用它，我该如何做？感谢您在开始循环工作表之前预先定义它，并将其作为参数传递给清除范围的过程。