删除文件夹中存在的多个Excel文件中的多个列

时间:2017-11-15 12:56:43

标签: excel vba excel-vba

我曾为一张excel表尝试过此代码。

Sub sbVBS_To_Delete_Multiple_Columns ()
Columns("A:C").EntireColumn.Delete
End Sub

这适用于文件夹中的一个excel表,我想循环遍历该文件夹中的所有excel文件并一次性完成,任何帮助表示赞赏。

添加遍历文件夹

中所有文件的逻辑
​Sub LoopAllExcelFilesInFolder()
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

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
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)    
 'Ensure Workbook has opened before moving on to next line of code
  DoEvents

 'Change First Worksheet's Background Fill Blue
  wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174)
  wb.Worksheets(1).Columns("A:B").EntireColumn.Delete
 'Save and Close Workbook
  wb.Close SaveChanges:=True      
 'Ensure Workbook has closed before moving on to next line of code
  DoEvents
 'Get next file name
  myFile = Dir
Loop
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

问题是兼容性检查程序,必须禁用它。

0 个答案:

没有答案