vbs批量删除excel中数值为0或为空的单元格

作用：遍历"配置清单表"文件夹下的xls文件，批量删除excel中数量为0或空的单元格。

test = createobject("Scripting.FileSystemObject").GetFile(Wscript.ScriptFullName).ParentFolder.Path

FileName=test + "\" + "设备报价表.xls"

Num = 8   'H列
var_test="value: "
aJiKuang_1=4
aBanka_1=0
aMokuai_1=0
aQiTa_1=0
aJiKuang_2=0
aBanka_2=0
aMokuai_2=0
aQiTa_2=0

   '函数1，打开后关闭xls文件，以更新
   Function openSave_xls(FileName)    
    'On Error Resume Next '如果后面的程序出现"运行时错误"时，会继续运行，不中断。
    
    set oExcel = CreateObject( "Excel.Application" )
    '不显示提示信息,这样保存的时候就不会提示是否要覆盖原文件
    oExcel.DisplayAlerts= false
    oExcel.Visible = false
    '1) 打开已存在的工作簿：
    oExcel.WorkBooks.Open( FileName )
    '2) 设置第2个工作表为活动工作表
    oExcel.WorkSheets(4).Activate
    '3) 关闭工作簿：
    oExcel.ActiveWorkBook.Save
    oExcel.WorkBooks.Close
    oExcel.Quit
    set oExcel = nothing
   End Function
   
         '函数2，删除空白行，“小计“统计方式
   Function Delete_xls(FileName)        
    'On Error Resume Next '如果后面的程序出现"运行时错误"时，会继续运行，不中断。
        
   set oExcel = CreateObject( "Excel.Application" )    
   '不显示提示信息,这样保存的时候就不会提示是否要覆盖原文件
    oExcel.DisplayAlerts=FALSE
    '调用EXCEL文件的时候不显示
    oExcel.Visible = False
    
    '1) 打开已存在的工作簿：    
    oExcel.WorkBooks.Open( FileName )    
    '2) 设置第3个工作表为活动工作表    
    oExcel.WorkSheets(4).Activate    
        
    '3) 机框，统计需处理多少行    , 从第5行开始
    i = aJiKuang_1 +1      
    '查找A列中所有的单元格
    doContinue=1
    Do while doContinue = 1
            MyPos = Instr(CStr(oExcel.Cells(i,1).Value), "计")   ' 默认情况下，进行的是二进制比较（省略了最后的参数）。存在则返回大于0。
            '  WScript.Echo "1.1 : " & CStr(oExcel.Cells(i,1).Value)& ", " & MyPos
            
            If MyPos > "0" Then
              doContinue = 0
            End if
     i = i+1    
    loop
       aJiKuang_1=4
       aJiKuang_2=i-1
       aBanka_1=i
       aMokuai_1=0
       aQiTa_1=0
       aBanka_2=0
       aMokuai_2=0
       aQiTa_2=0
    
       '3) 板卡，统计需处理多少行    , 从第5行开始
    i = aBanka_1 +1      
    '查找C列中所有的单元格
     doContinue=1
    Do while doContinue = 1
            MyPos = Instr(CStr(oExcel.Cells(i,1).Value), "计")   ' 默认情况下，进行的是二进制比较（省略了最后的参数）。存在则返回大于0。
            '  WScript.Echo "1.1 : " & CStr(oExcel.Cells(i,1).Value)& ", " & MyPos
            
            If MyPos > "0" Then
              doContinue = 0
            End if
     i = i+1    
    loop
    
       aBanka_2=i-1
       aMokuai_1=i    
    
        '3) 模块，统计需处理多少行    , 从第5行开始
    i = aMokuai_1 +1      
    '查找C列中所有的单元格
    doContinue=1
    Do while doContinue = 1
            MyPos = Instr(CStr(oExcel.Cells(i,1).Value), "计")   ' 默认情况下，进行的是二进制比较（省略了最后的参数）。存在则返回大于0。
            '  WScript.Echo "1.1 : " & CStr(oExcel.Cells(i,1).Value)& ", " & MyPos
            
            If MyPos > "0" Then
              doContinue = 0
            End if
     i = i+1    
    loop
    
       aMokuai_2=i -1
       aQiTa_1=i
    
        '3) 统计需处理多少行    , 从第5行开始
    i = aQiTa_1 +1      
    '查找C列中所有的单元格
    doContinue=1
    Do while doContinue = 1
            MyPos = Instr(CStr(oExcel.Cells(i,1).Value), "计")   ' 默认情况下，进行的是二进制比较（省略了最后的参数）。存在则返回大于0。
            '  WScript.Echo "1.1 : " & CStr(oExcel.Cells(i,1).Value)& ", " & MyPos
            
            If MyPos > "0" Then
              doContinue = 0
            End if
     i = i+1    
    loop
    
       aQiTa_2=i-1
      
    'MsgBox "i-final：" & ", " & aJiKuang_1& ", " & aJiKuang_2 & ", " &aBanka_1 & ", " &aBanka_2& ", " & aMokuai_1& ", " & aMokuai_2  & ", " & aQiTa_1 & ", " &aQiTa_2
    
     '4) 其他“数量”为空的行    
    i = aQiTa_2 -1    
    Do while i < aQiTa_2 And i > aQiTa_1'查找“数量”列中为空单元格,    
         
       if oExcel.Cells(i,1).Value <> "……" And ( oExcel.Cells(i,Num).Value = "" Or oExcel.Cells(i,Num).Value = "0" ) Then 'i是行，Num是列"    
        'var_test=var_test & i & "th- " & CStr(oExcel.Cells(i,Num).Value)+ ", "     
        oExcel.ActiveSheet.Rows(i).Delete      
     End if    
         
     i = i-1    
    loop    
    
     '4) 模块“数量”为空的行    
    i = aMokuai_2 -1    
    Do while i < aMokuai_2 And i > aMokuai_1'查找“数量”列中为空单元格,    
         
       if oExcel.Cells(i,1).Value <> "……" And ( oExcel.Cells(i,Num).Value = "" Or oExcel.Cells(i,Num).Value = "0" ) Then 'i是行，1是列"    
        'var_test=var_test & i & "th- " & CStr(oExcel.Cells(i,Num).Value)+ ", "     
        oExcel.ActiveSheet.Rows(i).Delete      
     End if    
         
     i = i-1    
    loop    
    
    '4) 板卡“数量”为空的行    
    i = aBanka_2 -1    
    Do while i < aBanka_2 And i > aBanka_1'查找“数量”列中为空单元格,    
         
       if oExcel.Cells(i,1).Value <> "……" And ( oExcel.Cells(i,Num).Value = "" Or oExcel.Cells(i,Num).Value = "0" ) Then 'i是行，1是列"    
        'var_test=var_test & i & "th- " & CStr(oExcel.Cells(i,Num).Value)+ ", "     
        oExcel.ActiveSheet.Rows(i).Delete      
     End if    
         
     i = i-1    
    loop    

    '4) 机框“数量”为空的行    
        i = aJiKuang_2 -1    
      Do while i < aJiKuang_2 And i > aJiKuang_1'查找“数量”列中为空单元格,    
       if oExcel.Cells(i,1).Value <> "……" And ( oExcel.Cells(i,Num).Value = "" Or oExcel.Cells(i,Num).Value = "0" ) Then 'i是行，1是列"    
            oExcel.ActiveSheet.Rows(i).Delete      
       End if    
       i = i-1    
      loop    
      
    oExcel.ActiveWorkBook.Save    
    oExcel.WorkBooks.Close    
    oExcel.Quit    
    set oExcel = nothing    
   End Function     
    

   '函数3，关闭打开的micrsoft excel 或wps excel，避免xls文件被占用带来的读写冲突。

   Function KillExcelProcess()

    on error resume Next
    'kill所有的macrosoft excel进程
    CreateObject("WScript.Shell").Run "taskkill /f /im EXCEL.EXE "
    'kill所有的wps excel进程
    CreateObject("WScript.Shell").Run "taskkill /f /im et.exe "
    WScript.Sleep 500

    'CreateObject("WScript.Shell").Run "taskkill /f /im Wscript.exe"
End Function   

   '函数4，遍历文件及子文件夹
   Function FilesTree(sPath, fileNamePart)    
    '遍历一个文件夹下的所有文件夹文件夹    
        Set oFso = CreateObject("Scripting.FileSystemObject")    
        Set oFolder = oFso.GetFolder(sPath)    
        Set oSubFolders = oFolder.SubFolders    
            
        Set oFiles = oFolder.Files    
        For Each oFile In oFiles    
           
            MyPos = Instr(oFile.Name, fileNamePart)   ' 默认情况下，进行的是二进制比较（省略了最后的参数）。存在则返回大于0。
            
            If MyPos > "0" Then
              Delete_xls oFile.Path  '删除数量为空的行。oFile.Path带路径，oFile.Name只有文件名    
            End if
        Next
            
        For Each oSubFolder In oSubFolders    
            FilesTree oSubFolder.Path, fileNamePart '递归    
        Next    
            
        Set oFolder = Nothing    
        Set oSubFolders = Nothing    
        Set oFso = Nothing    
    End Function    

'on error resume Next
 'do sth
 MsgBox "开始操作，结束时提示操作完成！"
 '关闭所有excel进程
 KillExcelProcess

 FilesTree "./", "配置清单表"  '遍历   
 MsgBox "操作完成"