macros进入一个文件夹并删除用户在所有XLS表单中input的表单

这里是我的工作代码,我只想让用户提示选项卡名称,以便用户可以select要删除的选项卡:

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 

将这些variables(或类似)添加到代码的顶部。

 Dim DelSheet as string Dim sht as worksheet 

获取工作表名称 – 这是一个例子,你可以从用户那里得到它

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

在上面修改你的代码的这一部分。 离开rest,因为它似乎工作正常。

 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 

FreeMan的回答更进一步(多张纸被删除)。

新的变数

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

用户提示的新循环

 '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 

其他设置

要摆脱Excelpopup式问题,如果您确定要删除工作表,可以在子开头处使用Application.DisplayAlerts = False