[已解决]删除同一个文件夹中多个工作薄中多个工作表相同列

yyylll888

我有一个文件夹，里面有30多个工作薄，每个工作薄中有四个工作表，我要删除每个工作薄中的每个工作表的第三列，爹六列，请问下怎么操作

最佳答案

月排行榜 / 总排行榜

dsmch

2014-6-7 19:01

1. Dim s%
   
2. Sub Macro1()
   
3. Dim mypath$, wj$, i%
   
4. s = s + 1
   
5. If s > 1 Then Exit Sub
   
6. mypath = ThisWorkbook.Path & "\模拟"
   
7. wj = Dir(mypath & "*.xls")
   
8. Application.ScreenUpdating = False
   
9. Application.DisplayAlerts = False
   
10. Do While wj <> ""
    
11.     Workbooks.Open (mypath & wj)
    
12.     For i = 1 To Sheets.Count
    
13.         Union(Sheets(i).[c:c], Sheets(i).[g:g]).Delete
    
14.     Next
    
15.     Workbooks("" & wj).Close 1
    
16.     wj = Dir
    
17. Loop
    
18. Application.DisplayAlerts = True
    
19. Application.ScreenUpdating = True
    
20. End Sub
    

复制代码

跳转到最佳答案楼层

dsmch

模拟附件，把excel文件压缩上传

yyylll888

dsmch 发表于 2014-6-7 18:27
模拟附件，把excel文件压缩上传

好的，就比如我这个附件里面4个工作薄，里面四个工作表，标黄色的是要删除的。以前都是打开一个工作薄，全选工作表以后手动删除，一个一个打开太麻烦。

dsmch

1. Dim s%
   
2. Sub Macro1()
   
3. Dim mypath$, wj$, i%
   
4. s = s + 1
   
5. If s > 1 Then Exit Sub
   
6. mypath = ThisWorkbook.Path & "\模拟"
   
7. wj = Dir(mypath & "*.xls")
   
8. Application.ScreenUpdating = False
   
9. Application.DisplayAlerts = False
   
10. Do While wj <> ""
    
11.     Workbooks.Open (mypath & wj)
    
12.     For i = 1 To Sheets.Count
    
13.         Union(Sheets(i).[c:c], Sheets(i).[g:g]).Delete
    
14.     Next
    
15.     Workbooks("" & wj).Close 1
    
16.     wj = Dir
    
17. Loop
    
18. Application.DisplayAlerts = True
    
19. Application.ScreenUpdating = True
    
20. End Sub
    

复制代码

dsmch

………………

yyylll888

dsmch 发表于 2014-6-7 19:02
………………

我启用宏，按了按钮 好像没有用，我有三十多个工作薄，你能告诉我怎么操作吗

yyylll888

dsmch 发表于 2014-6-7 19:02
………………

谢谢大神，我会了，谢谢

tgydslr

dsmch 发表于 2014-6-7 19:01

佩服啊，vba真是神了