Question

我想做什么：

如果存在未命名为“宏”的工作表 > 使用 MsgBox 提示用户 > 如果是，则删除所有未命名为“宏”的工作表

但只显示 MsgBox ONCE（如果存在超过 1 个工作表，则不为每个工作表显示 MsgBox）

当前代码的问题： 当“宏”是唯一存在的工作表时，仍然收到 MsgBox 提示。

当前代码：

Sub reset()
    
    Dim conditionMet As Boolean
    Dim answer      As Integer
    
    conditionMet = FALSE
    answer = MsgBox("There Is already data here. Click Yes To delete reset macro.", vbQuestion + vbYesNo)
    
    Application.DisplayAlerts = FALSE
    
    For Each Sheet In ThisWorkbook.Worksheets
        If Sheet.Name <> "Macro" Then
            conditionMet = TRUE
        Else
            Exit Sub
        End If
    Next Sheet
    
    If conditionMet Then
        If answer = vbYes Then
            Sheet.Delete
        Else
            Exit Sub
        End If
    Else
        Exit Sub
    End If
    
    Application.DisplayAlerts = TRUE
    
End Sub

Answer 1

这是一种方法：

Const KEEP_THIS As String = "Macro"
Dim ws As Worksheet

On Error Resume Next
Set ws = ThisWorkbook.Sheets(KEEP_THIS)
On Error GoTo 0
If ws Is Nothing Or ThisWorkbook.Worksheets.Count = 1 Then Exit Sub 'no "Macro" sheet

If MsgBox("Delete all data sheets?", vbQuestion + vbYesNo) <> vbYes Then Exit Sub
'remove all non-Macro sheets
For i = ThisWorkbook.Worksheets.Count To 1 Step -1
    With ThisWorkbook.Worksheets(i)
        If .Name <> KEEP_THIS Then .Delete
    End With
Next i

Answer 2

删除除指定工作表之外的所有工作表

以下内容展示了如何避免一些（不太常见的）意外。

代码

Option Explicit

Sub resetWorkbook()
    
    Const SheetName As String = "Macro"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' There has to be at least one sheet in the workbook.
    If wb.Sheets.Count = 1 Then Exit Sub
    
    ' Check for existence.
    On Error Resume Next
    Dim sh As Object: Set sh = wb.Sheets(SheetName)
    On Error GoTo 0
    If sh Is Nothing Then Exit Sub
    
    If MsgBox("There Is already data here. Click Yes To delete reset macro.", _
        vbQuestion + vbYesNo) = vbNo Then Exit Sub
    
    ' An only sheet in a workbook has to be visible.
    If Not sh.Visible = xlSheetVisible Then
        sh.Visible = xlSheetVisible
    End If
    
    ' Write the other sheet names to an array.
    Dim SheetNames() As String: ReDim SheetNames(1 To wb.Sheets.Count - 1)
    Dim n As Long
    For Each sh In wb.Sheets
        ' Allow case-insensitivity i.e. A = a.
        If StrComp(sh.Name, SheetName, vbTextCompare) <> 0 Then
            n = n + 1
            SheetNames(n) = sh.Name
        End If
    Next sh
    
    ' Delete sheets in one go with no pop-ups.
    Application.DisplayAlerts = False
    wb.Sheets(SheetNames).Delete
    Application.DisplayAlerts = True
    
    ' Inform.
    MsgBox "Number of sheets deleted: " & n, vbInformation, "Success"
    
End Sub

如何在 For Each 循环之外创建 vbYesNo MsgBox？

2 个答案:

删除除指定工作表之外的所有工作表