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

【问题标题】：Keep only a range in all sheets - VBA在所有工作表中只保留一个范围 - VBA
【发布时间】：2019-12-30 14:29:39
【问题描述】：

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

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

请帮我解决这个错误。

提前致谢。

【问题讨论】：

您只能使用ActiveSheet 运行它。为什么你会期望它除了一张纸之外还能对其他任何东西起作用？这不是错误；代码完全按照您的要求执行。
@KenWhite 如何使其动态并循环遍历所有工作表？
通过访问Sheets() 集合。您已经在 for 循环中获得了它的索引。更改您的代码以访问该索引处的工作表。在此站点中搜索 [excel][vba] loop through all sheets 以获取示例。
@KenWhite 一个后续问题，如果我想首先定义范围并通过循环所有工作表来使用它，我该怎么做？提前致谢
在开始循环工作表之前定义它，并将其作为参数传递给清除范围的过程。

标签： excel vba loops worksheet

【解决方案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

【讨论】：