Question

这是我的工作代码，我只想让用户提示选项卡名称，以便用户可以选择要删除的选项卡：

Sub LoopAllExcelFilesInFolder()

'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog

'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
  myExtension = "*.xls"

'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)

'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
      Set wb = Workbooks.Open(Filename:=myPath & myFile)

    'Change First Worksheet's Background Fill Blue
      'wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174)
      wb.Worksheets(2).Delete

    'Save and Close Workbook
      wb.Close SaveChanges:=True

    'Get next file name
      myFile = Dir
  Loop

'Message Box when tasks are completed
  MsgBox "Task Complete!"

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

Answer 1

将这些变量（或类似）添加到代码顶部。

Dim DelSheet as string
Dim sht as worksheet

获取工作表名称 - 这是一个示例，您可以从用户那里获得

DelSheet = InputBox(Prompt:="Enter the name of the sheet to delete")

修改上面代码的这一部分。保持原样，因为它似乎工作正常。

Do While myFile <> ""
  'Set variable equal to opened workbook
  Set wb = Workbooks.Open(Filename:=myPath & myFile)

  'this loop isn't particularly efficient, but it prevents attempting
  'deletion of the sheet if that sheet doesn't exist in the wb
  'you could wrap the code in an "On Error..." block instead
  for each sht in wb.sheets
    if sht.name = DelSheet then
      wb.Worksheets(DelSheet).Delete
    endif
  next

  'Save and Close Workbook
  wb.Close SaveChanges:=True

'Get next file name
  myFile = Dir
Loop

Answer 2

FreeMan的答案更进了一步（要删除多张表）。

新变量

Dim DelSheets() As String 'array
Dim intDelSheetCount As Integer
Dim DelSht As Variant

用户promt的新循环

'ask user multiple times, which sheets he wants to delete
Do
ReDim Preserve DelSheets(intDelSheetCount)
DelSheets(intDelSheetCount) = InputBox(Prompt:="Enter the name of the sheet to delete")
intMsgBoxAnswer = MsgBox("Do you want to type more sheets to be deleted?", vbYesNo)
intDelSheetCount = intDelSheetCount + 1
Loop While intMsgBoxAnswer = 6 'while the answer is YES

删除循环

  For Each sht In wb.Sheets
    For Each DelSht In DelSheets
        If sht.Name = DelSht Then
          DelSht.Delete
        End If
    Next DelSht
  Next

其他设置

要摆脱Excel弹出式问题，如果您确定要删除工作表，可以在子开头使用Application.DisplayAlerts = False。

宏转到文件夹并删除用户在所有XLS工作表中输入的工作表

2 个答案:

新变量

用户promt的新循环

删除循环

其他设置