批量删除工作表与列数据的问题

杨小妹

附件 批量删除工作表与列数据.rar (601.83 KB, 下载次数: 18)

2024-3-16 09:20 上传

点击文件名下载附件

谢谢老师！

蓝桥玄霜

删除的例子：

gwjkkkkk

Option Explicit
Sub test()
    Dim strFileName$, strPath$
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
    strPath = ThisWorkbook.Path & "\"
    strFileName = Dir(strPath & "*.xls*")
    Do Until strFileName = ""
        If strFileName <> ThisWorkbook.Name Then
            With Workbooks.Open(strPath & strFileName)
                Worksheets("Sheet2").Delete
                Union(Columns("A:L"), Columns("P"), Columns("R:V")).Delete
            End With
            wkb.Close True
        End If
        strFileName = Dir
    Loop
   
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Beep
End Sub

gwjkkkkk

请参考附件。。。

ykcbf1100

参与一下。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.3.16
   
2.     Set Fso = CreateObject("scripting.filesystemobject")
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     Set sh = ThisWorkbook.Sheets("Sheet1")
   
6.     p = ThisWorkbook.Path & ""
   
7.     For Each f In Fso.GetFolder(p).Files
   
8.         If f.Name Like "*.xlsb" Then
   
9.             fn = Fso.GetBaseName(f)
   
10.             Set wb = Workbooks.Open(f, 0)
    
11.             wb.Sheets("Sheet2").Delete
    
12.             b = [{1,2,3,4,5,6,7,8,9,10,11,12,16,18,19,20,21,22}]
    
13.             With wb.Sheets("Sheet1")
    
14.                 For j = UBound(b) To 1 Step -1
    
15.                     .Columns(b(j)).Delete
    
16.                 Next
    
17.             End With
    
18.             wb.Close 1
    
19.         End If
    
20.     Next f
    
21.     Application.ScreenUpdating = True
    
22.     MsgBox "OK！"
    
23. End Sub
    

复制代码