[已解决]批量删除多个工作表的第G列到第L列~~~~~

cqj603

VBA真是太神奇了！

最佳答案

月排行榜 / 总排行榜

爱疯

2013-7-21 12:43

1. Sub test()
   
2.     Dim p$, f$, x, c As Range
   
3. 
   
4.     Application.ScreenUpdating = False
   
5.     Application.DisplayAlerts = False
   
6.     p = ThisWorkbook.Path & "\file"
   
7.     f = Dir(p & "*.xls")
   
8.     x = "2011-2012-1"
   
9. 
   
10.     Do While f <> ""
    
11.         Workbooks.Open p & f
    
12.         '''''''''''''''''''''''''''''''''''''''''''
    
13.         With ActiveSheet
    
14.             .Columns("g:L").Delete
    
15.             .Rows(1).Delete
    
16.             .Rows(.UsedRange.Rows.Count).Clear
    
17.             Set c = .Cells.Find(x)
    
18.             If Not c Is Nothing Then
    
19.                 Do
    
20.                     c.EntireRow.Delete
    
21.                     Set c = .Cells.Find(x)
    
22.                 Loop While Not c Is Nothing
    
23.             End If
    
24.         End With
    
25.         '''''''''''''''''''''''''''''''''''''''''''
    
26.         ActiveWorkbook.Close 1
    
27.         f = Dir
    
28.     Loop
    
29.     MsgBox "完成"
    
30. End Sub

复制代码

222.rar (14.38 KB, 下载次数: 121)

2013-7-21 12:43 上传

点击文件名下载附件

没见附件中有"2011-2012-1"啊？
x = "2011-2012-1"
把代码中这句的颜色部分，改为查找内容

跳转到最佳答案楼层

sliang28

2000多个得运行好一会吧{:3912:}
上传个附件吧,不要两千个,其中一个就可以

cqj603

附件为样表，请高手赐教！

sliang28

你的表里面没有2011-2012-1它啊
能否一次性讲清楚了,你要写清楚一点,效果要达到随便从大街上拉一个来,一看都知道你要干什么.

爱疯

1. Sub test()
   
2.     Dim p$, f$, x, c As Range
   
3. 
   
4.     Application.ScreenUpdating = False
   
5.     Application.DisplayAlerts = False
   
6.     p = ThisWorkbook.Path & "\file"
   
7.     f = Dir(p & "*.xls")
   
8.     x = "2011-2012-1"
   
9. 
   
10.     Do While f <> ""
    
11.         Workbooks.Open p & f
    
12.         '''''''''''''''''''''''''''''''''''''''''''
    
13.         With ActiveSheet
    
14.             .Columns("g:L").Delete
    
15.             .Rows(1).Delete
    
16.             .Rows(.UsedRange.Rows.Count).Clear
    
17.             Set c = .Cells.Find(x)
    
18.             If Not c Is Nothing Then
    
19.                 Do
    
20.                     c.EntireRow.Delete
    
21.                     Set c = .Cells.Find(x)
    
22.                 Loop While Not c Is Nothing
    
23.             End If
    
24.         End With
    
25.         '''''''''''''''''''''''''''''''''''''''''''
    
26.         ActiveWorkbook.Close 1
    
27.         f = Dir
    
28.     Loop
    
29.     MsgBox "完成"
    
30. End Sub

复制代码

222.rar (14.38 KB, 下载次数: 121)

2013-7-21 12:43 上传

点击文件名下载附件

没见附件中有"2011-2012-1"啊？
x = "2011-2012-1"
把代码中这句的颜色部分，改为查找内容

shblove

学习啊~！

cqj603

爱疯 发表于 2013-7-21 12:43
没见附件中有"2011-2012-1"啊？
x = "2011-2012-1"
把代码中这句的颜色部分，改为查找内 ...

我想借这个机会学习一下VBA，目前还没有入门。样表是一个学生的考试成绩表，每个学期的那一行都需要删除，所以随便写了个“2011-2012学年第一学期”的简写，想通过高手的程序，自己读懂后，改为自己所需要的，十分感谢！