excel自动删除sheet及列

答案:2 悬赏:30 手机版

解决时间 2021-12-30 13:27

提问者网友：两耳就是菩提
2021-12-30 02:02

我有些已整理好的数据，比如说该excel文件名称为excel, 共有sheet1,sheet2共2个sheet,其中sheet1有ABCDEFGH共8列，我想把整个sheet2删除，sheet1中的D,H列自动删除，其余的数据均保存下来，同时这个excel文件执行完这两个删除的动作后，能自动另存为excel-2.
请问有无方便点的程序来自动整理？
因我有大量这样的excel文件，我希望能有个程序能直接运行就可以自动直接导入文件，执行动作，然后输出想要的新的名称的目标文件。这样就不需要我每个excel文件都打开了操作了。

不要告诉我打开手动删除sheet2，D列，H列。再另存为excel-2，我是想要自动执行的程序，而不是手动执行的。多谢了！

最佳答案

五星知识达人网友：轻熟杀无赦
2021-12-30 02:50

打开excel，alt+F11，插入模块，将下面代码复制进去，按F5，选择需要操作的文件，点确定。
Sub deleteWorkbooks()
        Dim FilesToOpen, ft
        Dim x As Integer
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        On Error GoTo errhandler
        FilesToOpen = Application.GetOpenFilename _
        (FileFilter:="Micrsofe Excel文件(*.xls;*.xlsx), *.xls;*.xlsx", _
        MultiSelect:=True, Title:="要合并的文件")
        If TypeName(FilesToOpen) = "boolean" Then
            MsgBox ("没有选定文件")
        End If
        x = 1
        Do While x            Set wk = Workbooks.Open(Filename:=FilesToOpen(x))
           wknm = wk.Name
           If Left(Right(wknm, 4), 1) = "." Then
            newwknm = Left(wknm, Len(wknm) - 4) & "_2.xls"
           Else
            newwknm = Left(wknm, Len(wknm) - 5) & "_2.xlsx"
           End If
           wk.Sheets(2).Delete
           wk.Sheets(1).Range("h:h").Delete
           wk.Sheets(1).Range("d:d").Delete
           wk.SaveAs Filename:=newwknm
           wk.Close savechanges:=False
           x = x + 1
        Loop
       Application.ScreenUpdating = True
       Application.DisplayAlerts = True
        MsgBox ("操作成功完成！")
errhandler:
    end sub

全部回答

1楼网友：北方的南先生
2021-12-30 04:25

打开excel，alt+f11，插入模块，将下面代码复制进去，按f5，选择需要操作的文件，点确定。

sub deleteworkbooks() dim filestoopen, ft dim x as integer application.screenupdating = false application.displayalerts = false on error goto errhandler filestoopen = application.getopenfilename _ (filefilter:="micrsofe excel文件(*.xls;*.xlsx), *.xls;*.xlsx", _ multiselect:=true, title:="要合并的文件") if typename(filestoopen) = "boolean" then msgbox ("没有选定文件") end if x = 1 do while x <= ubound(filestoopen) set wk = workbooks.open(filename:=filestoopen(x)) wknm = wk.name if left(right(wknm, 4), 1) = "." then newwknm = left(wknm, len(wknm) - 4) & "_2.xls" else newwknm = left(wknm, len(wknm) - 5) & "_2.xlsx" end if wk.sheets(2).delete wk.sheets(1).range("h:h").delete wk.sheets(1).range("d:d").delete wk.saveas filename:=newwknm wk.close savechanges:=false x = x + 1 loop application.screenupdating = true application.displayalerts = true msgbox ("操作成功完成！") errhandler: end sub

我要举报

如以上回答内容为低俗、色情、不良、暴力、侵权、涉及违法等信息，可以点下面链接进行举报！

点此我要举报以上问答信息