2015年VBA初级1班 B组第6第7讲作业上交贴 已开贴

qh8600

2015年VBA初级1班 B组作业上交贴
第6讲视频http://www.excelpx.com/thread-367601-1-1.html
第7讲视频http://www.excelpx.com/thread-367961-1-1.html
第6，7讲作业http://www.excelpx.com/thread-367945-1-1.html

要求：
1、提交作业请注明论坛ID及学号。如：B19-白开水的微笑；
2、作业请以代码方式提交，标清题号并所有题贴到一个代码标签中，无需提交附件。不会使用标签可移步妙妙班长帖子：http://www.excelpx.com/thread-322284-1-1.html
3、代码题要求强制声明变量，代码缩进及代码注释(缺少任何一项按错误处理没有分)；
4、跟帖不要重复占楼,有问题直接在原帖编辑;
5、非本组学员请勿跟帖，否者往死里扣分；
6、作业截止时间：2015年7月28日18:00时

ZL在水一方

B17-ZL在水一方

1. Option Explicit
   
2. Sub 删除标题行1()
   
3.     Dim i%, MyRow%  '定义变量
   
4.     MyRow = Cells(Rows.Count, 1).End(xlUp).Row  '取得第一列的最后一个非空单元格的行数
   
5.     Application.ScreenUpdating = False  '关闭刷新
   
6.     For i = MyRow To 3 Step -1 '变量i由总行数到3进行遍历
   
7.         If Range("a" & i) = "姓名" Then '如果单元格值为姓名，则执行下面语句
   
8.             Range("a" & i, "i" & i).Delete  '删除当前单元格所在的行信息
   
9.         End If
   
10.     Next
    
11.     Application.ScreenUpdating = True   '开启刷新
    
12. End Sub
    

复制代码

1. Option Explicit
   
2. Sub 删除标题行2()
   
3.     Dim i%, MyRow%, MyCol%  '定义变量
   
4.     MyRow = Cells(Rows.Count, 1).End(xlUp).Row  '取得第一列的最后一个非空单元格的行数
   
5.     MyCol = Cells(2, Columns.Count).End(xlToRight).Column   '取得第二行的最后一个非空单元格的列数
   
6.     Application.ScreenUpdating = False  '关闭刷新
   
7.     For i = MyRow To 3 Step -1  '变量i由总行数到3进行遍历
   
8.         If Cells(i, 1) = "姓名" Then    '如果单元格值为姓名，则执行下面语句
   
9.             Cells(i, 1).Resize(1, MyCol).Delete  '删除当前单元格所在的1行MyCol列的区域信息
   
10.         End If
    
11.     Next
    
12.     Application.ScreenUpdating = True    '开启刷新
    
13. End Sub
    

复制代码

1. Option Explicit
   
2. Sub 删除标题行3()
   
3.     Dim i%, MyRow%, arr  '定义变量
   
4.     MyRow = Cells(Rows.Count, 1).End(xlUp).Row   '取得第一列的最后一个非空单元格的行数
   
5.     arr = Range("a3:i" & MyRow) '将单元格区域赋值给数组
   
6.     Application.ScreenUpdating = False  '关闭刷新
   
7.     For i = UBound(arr) To 1 Step -1     '变量i由数组的最大下界到1进行遍历
   
8.         If arr(i, 1) = "姓名" Then  '数组第一列值满足条件则执行以下语句
   
9.             Cells(i + 2, 1).EntireRow.Delete    '当前单元格所在行删除
   
10.         End If
    
11.     Next
    
12.     Application.ScreenUpdating = True   '开启刷新
    
13. End Sub
    

复制代码

xcnclzy

1. Sub 删除标题行()
   
2.     Dim i%, j%
   
3.     ActiveSheet.AutoFilterMode = False
   
4.     Application.ScreenUpdating = False
   
5.     j = Range("a65536").End(xlUp).Row
   
6.     For i = 1 To j / 2
   
7.         Cells(i + 3, 1).EntireRow.Delete
   
8.     Next
   
9.     Range("a2:a2").Select
   
10.     Application.ScreenUpdating = True
    
11.     Selection.AutoFilter
    
12. End Sub
    

复制代码

采姑娘的小蘑菇

先交了有时间再看看怎样修改，

1. Sub 按钮1_Click()
   
2.     Application.ScreenUpdating = False
   
3. '关闭屏幕更新
   
4.     Dim i%, j%
   
5.     Worksheets("工资表").Activate
   
6. '激活“工资表”
   
7.     Range("A2").AutoFilter Field:=1
   
8. '将A2所在区域成为筛选状态
   
9.     j = Range("a1").CurrentRegion.Rows.Count
   
10. '计算工资表的最大行号
    
11.     For i = j To 4 Step -1
    
12.         If Cells(i, 1) = "姓名" Then Range(Cells(i, 1), Cells(i, 9)).Delete shift:=2
    
13.     Next
    
14. '从最后一行当A列的单元格等于“姓名”时删除当前行
    
15.     [a1].Select
    
16.     Application.ScreenUpdating = True
    
17.     '打开屏幕更新
    
18. End Sub

复制代码

1. Sub 删除标题之for循环()
   
2.     Application.ScreenUpdating = False
   
3.     Dim i%, j%
   
4.      Worksheets("工资表").Activate
   
5.      Range("A2").AutoFilter Field:=1
   
6.     j = Range("a1").CurrentRegion.Rows.Count
   
7. '    j = Range("a1").End(xlDown).Row
   
8. '    j = Range("a" & Rows.Count).End(xlUp).Row
   
9.     For i = 3 To j
   
10.         If Cells(i, 1) = "姓名" Then Range(Cells(i, 1), Cells(i, 9)).Delete shift:=2
    
11.     Next
    
12.     [a1].Select
    
13.     Application.ScreenUpdating = True
    
14. End Sub

复制代码

1. Sub 删除标题之forEach循环()
   
2.     Application.ScreenUpdating = False
   
3.     Dim i%, j%, rng
   
4.      Worksheets("工资表").Activate
   
5.      Range("A2").AutoFilter Field:=1
   
6.     i = Range("a1").CurrentRegion.Rows.Count
   
7.     For Each rng In Range("A3:A" & i)
   
8.         If rng = "姓名" Then Range(Cells(rng.Row, 1), Cells(rng.Row, 9)).Delete shift:=2
   
9.     Next
   
10.     [a1].Select
    
11.     Application.ScreenUpdating = True
    
12. End Sub

复制代码

1. Sub 删除标题之DoWhileLoop循环()
   
2.     Application.ScreenUpdating = False
   
3.     Dim i%, j%
   
4.      Worksheets("工资表").Activate
   
5.      Range("A2").AutoFilter Field:=1
   
6.     j = Range("a1").CurrentRegion.Rows.Count
   
7.     i = 3
   
8.     Do While i < j
   
9.             If Cells(i, 1) = "姓名" Then Range(Cells(i, 1), Cells(i, 9)).Delete shift:=2
   
10.             i = i + 1
    
11.     Loop
    
12.     [a1].Select
    
13.     Application.ScreenUpdating = True
    
14. End Sub

复制代码

1. Sub 删除标题之DoUntilLoop循环()
   
2.     Application.ScreenUpdating = False
   
3.     Dim i%, j%
   
4.      Worksheets("工资表").Activate
   
5.      Range("A2").AutoFilter Field:=1
   
6.     j = Range("a1").CurrentRegion.Rows.Count
   
7.     i = 3
   
8.     Do Until i > j
   
9.             If Cells(i, 1) = "姓名" Then Range(Cells(i, 1), Cells(i, 9)).Delete shift:=2
   
10.             i = i + 1
    
11.     Loop
    
12.     [a1].Select
    
13.     Application.ScreenUpdating = True
    
14. End Sub

复制代码

1. Sub 删除标题之DoLoopWhile循环()
   
2.     Application.ScreenUpdating = False
   
3.     Dim i%, j%
   
4.      Worksheets("工资表").Activate
   
5.      Range("A2").AutoFilter Field:=1
   
6.     j = Range("a1").CurrentRegion.Rows.Count
   
7.     i = 3
   
8.     Do
   
9.             If Cells(i, 1) = "姓名" Then Range(Cells(i, 1), Cells(i, 9)).Delete shift:=2
   
10.             i = i + 1
    
11.     Loop While i < j
    
12.     [a1].Select
    
13.     Application.ScreenUpdating = True
    
14. End Sub

复制代码

1. Sub 删除标题之DoLoopUntil循环()
   
2.     Application.ScreenUpdating = False
   
3.     Dim i%, j%
   
4.      Worksheets("工资表").Activate
   
5.      Range("A2").AutoFilter Field:=1
   
6.     j = Range("a1").CurrentRegion.Rows.Count
   
7.     i = 3
   
8.     Do
   
9.             If Cells(i, 1) = "姓名" Then Range(Cells(i, 1), Cells(i, 9)).Delete shift:=2
   
10.             i = i + 1
    
11.     Loop Until i > j
    
12.     [a1].Select
    
13.     Application.ScreenUpdating = True
    
14. End Sub

复制代码

白开水的微笑

B19-白开水的微笑

1. Option Explicit
   
2. 
   
3. '删除标题行
   
4. Sub deleteTitle()
   
5.     Dim rowN        As Long '用于循环遍历的行号变量
   
6.     Dim lastRowN    As Long '总的行数
   
7.    
   
8.     '关闭屏幕刷新
   
9.     Application.ScreenUpdating = False
   
10.    
    
11.     '获取总的行数
    
12.     lastRowN = Range("A:A").Find("*", Range("A1"), SearchDirection:=xlPrevious).Row
    
13.    
    
14.     '从倒数第二行开始隔行循环
    
15.     For rowN = lastRowN - 1 To 3 Step -2
    
16.         '删除当前行
    
17.         Rows(rowN).Delete Shift:=xlUp
    
18.     Next rowN
    
19.    
    
20.     '打开屏幕刷新
    
21.     Application.ScreenUpdating = True
    
22. End Sub

复制代码

opqazxc

B10-opqazxc

1. Option Explicit
   
2. 
   
3. Sub 删除标题行()
   
4.     Dim x As Integer    '定义变量x声明其类型为整型
   
5.     x = 3    '给变量x赋值为3
   
6.     Do    '开始循环
   
7.         x = x + 1    '先将x=3代入,得到新的x
   
8.         Rows(x).Delete    '删除第x行,
   
9.     Loop Until Range("a" & x + 1) = ""    '判断删除第x行后,单元格"a"&x+1是否为空,是的话结束循环，否的话将新的x代入开始循环处,继续循环
   
10. End Sub

复制代码