clarkoicq
clarkoicq
采纳率0%
2018-01-19 02:00 阅读 3.5k

有没有能批量删除EXCEL宏代码的方法

20

公司有一个目录,下面快10W个EXCEL文件,
每个EXCEL文件里都有宏代码(VBA代码),现在里面的宏代码已经不适用,想批量删除存在的宏代码。

有高手请出来指点一下(用编程语言或者其它工具,只要能实现就行。)

补充:是EXCEL里面写VBA代码,VBA代码是从数据库里取数据来填充指定EXCEL单元格。现在这段VBA代码需要取消,但是目前目录下有10G EXCEL文件,如果是人去操作不现实,所以才有此问。
图片说明

  • 点赞
  • 写回答
  • 关注问题
  • 收藏
  • 复制链接分享

7条回答 默认 最新

  • weixin_41492479 VangPao 2018-01-19 02:01

    等有厉害的人就会告诉你了.

    点赞 评论 复制链接分享
  • caixingbing style兵兵 2018-01-19 02:05

    等→厉害的人就会告诉你了.

    点赞 评论 复制链接分享
  • qq_39360549 小佬 2018-01-19 02:10

    兄弟。直接删库。delete一下。完事。简单明了。,不行就删库跑路

    点赞 评论 复制链接分享
  • lyy289065406 小優YoU 2018-01-19 03:10

    写个程序,遍历目录下的Excel,逐个打开,找到宏代码的单元格,删除,保存Excel,完了。
    随便什么编程语言都可以, 找个Excel解析库就可以做了, 网上一搜一堆。

    点赞 评论 复制链接分享
  • qq_36361624 qq_36361624 2018-01-19 03:21

    delete一下。完事。简单明了。

    点赞 评论 复制链接分享
  • zhuanghua13 庄华 2018-01-19 07:11

    搞定了。代码给你
    '1.用户可以任意选择文件夹进行遍历
    ' 2.限定遍历时仅搜索EXCEL文件(你可以改变文件类型)
    '这个程序要先在“引用”下选择"microsoft scripting runtime"库文件

    Dim ArryFile() As String
    Dim nFile As Integer

    Sub Filelist()
    Dim fso As New FileSystemObject
    Dim fd As Folder
    Dim strFilePath As String
    Dim FolderSelect As FileDialog
    Set FolderSelect = Application.FileDialog(msoFileDialogFolderPicker)
    With FolderSelect
    If .Show = -1 Then
    strFilePath = .SelectedItems.Item(1) & ""
    End If
    End With
    Set fd = fso.GetFolder(strFilePath)
    nFile = 0
    searchFile fd

    End Sub
    Private Function searchFile(ByVal fd As Folder)
    Dim fl As File
    Dim subfd As Folder
    Dim i As Integer
    On Error Resume Next

    i = fd.Files.Count
    
    ReDim Preserve ArryFile(1 To nFile + i)
    For Each fl In fd.Files
        If Right(fl.Name, 4) = "xlsx" Then       '后缀是xls的用   If Right(fl.Name, 3) = "xls" Then
            nFile = nFile + 1
            ArryFile(nFile) = fl.Path
        End If
    Next
    If fd.SubFolders.Count = 0 Then Exit Function
    For Each subfd In fd.SubFolders
        searchFile subfd
    Next
    

    End Function

    Sub ttt1()

    Dim xlname, myxl As Object, sh As Object

    Call Filelist

    Set myxl = CreateObject("Aplication.Excel")

    If nFile > 0 Then
    
       For Each xlname In ArryFile()
            If xlname <> "" Then
               Set sh = myxl.Workbook.Open(xlname)
    
                Call 你的宏名                            '你的宏名
    
                sh.SaveAs Filename:=sxlname
                sh.Close 0
    
                Set sh = Nothing
            End If
    
       Next       
    
    
    End If
    

    Set myxl = Nothing

    End Sub

    '模块2
    Sub 自动删除代码()

    Application.DisplayAlerts = False '如果宏运行时 Microsoft Excel 显示特定的警告和消息,则该值为 True。Boolean 类型,可读写。

    For i = 1 To ThisWorkbook.VBProject.VBComponents.Count

    With ThisWorkbook.VBProject.VBComponents(i).CodeModule

    .DeleteLines 1, .CountOfLines

    End With
    Next
    Dim Vbc As Object

    For Each Vbc In Application.ThisWorkbook.VBProject.VBComponents
    Select Case Vbc.Type

     Case 1, 2, 3
    
          With Application.VBE.ActiveVBProject.VBComponents
    
          .Remove .Item(Vbc.Name)
    
      End With
    
      End Select
    

    Next
    End Sub

    点赞 评论 复制链接分享
  • mango_love mango_love 2018-01-19 10:31

    试试这个

     Private Sub Worksheet_Change(ByVal Target As Range)
        On Error Resume Next
        Application.EnableEvents = False
        Range("a7:J52").SpecialCells(xlCellTypeBlanks).Delete
        Application.EnableEvents = True
    End Sub
    
    点赞 评论 复制链接分享

相关推荐