VBA第7讲习题---学员答案上传专贴

晴空 · 发表于 2008-6-16 16:55

[Power=5]

R0MRueA9.rar (45.78 KB, 下载次数: 2)

ljx63426 · 发表于 2008-6-16 22:00

学习一下

泓叶 · 发表于 2008-6-17 01:58

游客，如果您要查看本帖隐藏内容请回复

+7

[此贴子已经被laosanjie于2008-6-18 13:41:59编辑过]

annefei · 发表于 2008-6-17 10:31

[Power=5] 第一题： Sub 隐藏() Dim x  For x = 1 To 14   If Cells(x, 1) = "" And Cells(x, 2) = "" Then     Rows(x).Hidden = True   End If  Next x End Sub第二题Sub 添加() Dim X As Integer For X = [A65536].End(xlUp).Row To 3 Step -1   Rows(X & ":" & X + 1).Insert Next X End Sub 第三题Sub lastblank() MsgBox Range("A1:d12").Find("", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Address End Sub第四题Sub 合并() Dim X As Integer  For X = 2 To 12    Cells(X, 6) = Cells(X, 5).End(xlToLeft).Value  Next X End Sub第五题Sub 取不重复() Dim MRG As Range  For Each MRG In Range("a1:d12")    If MRG >= "D" And MRG <= "W" Then     If Application.CountIf([F:F], MRG.Value) = 0 Then      [F65536].End(xlUp).Offset(1, 0) = MRG.Value     End If    End If  Next MRG End Sub第六题Sub 合并() Dim x  For x = [a65536].End(xlUp).Row To 2 Step -1    If Cells(x, 1) = Cells(x - 1, 1) Then      Application.DisplayAlerts = False        Range(Cells(x, 1), Cells(x - 1, 1)).Merge     Application.DisplayAlerts = True    End If  Next x End Sub第七题Sub 累计值() Dim k As Integer, x As Integer, m As Integer k = [c65536].End(xlUp).Row + 1 For m = Application.CountA([a1:a15]) To 2 Step -1    x = 0    Do      k = k - 1      x = x + Cells(k, 3)    Loop Until Cells(k, 1) <> ""  Cells(k, 4) = x  Next m End Sub [/Power]+7

[此贴子已经被laosanjie于2008-6-18 13:45:04编辑过]

magiclight · 发表于 2008-6-17 14:51

[Power=5]

XAjKcufX.rar (48.06 KB, 下载次数: 3)

紫龙 · 发表于 2008-6-17 19:54

xuexile

bestway · 发表于 2008-6-17 20:08

游客，如果您要查看本帖隐藏内容请回复

+7

[此贴子已经被laosanjie于2008-6-18 13:53:25编辑过]

千屈菜 · 发表于 2008-6-17 21:05

[Power=5] 第1例：隐藏空行 Sub 常规() Dim x  For x = 1 To 14   If Cells(x, 1) = "" And Cells(x, 2) = "" Then     Rows(x).Hidden = True   End If  Next x End Sub Sub 取消隐藏()  Rows("1:15").Hidden = False End Sub Sub 隐藏空行() 'by colby Dim x As Range, y As Range Set x = Range("A1:A14").SpecialCells(xlCellTypeBlanks) Set y = Range("b1:b14").SpecialCells(xlCellTypeBlanks).Offset(, -1) Intersect(x, y).EntireRow.Hidden = True End Sub Sub 技巧法()     Rows("1:14").EntireRow.Hidden = True     Range("a1:b15").Select     Selection.RowDifferences(ActiveCell).EntireRow.Hidden = False End Sub      第2例：隔行插入空行 Sub 添加空行() Dim X As Integer For X = [A65536].End(xlUp).Row To 3 Step -1   Rows(X & ":" & X + 1).Insert Next X End Sub Sub 删除空行()  Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete End Sub             第3例：查找最后一个空格 Sub b() MsgBox Range("A1:d12").Find("", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Address End Sub      第4例：列的合并 Sub HB() Dim X As Integer  For X = 2 To 12    Cells(X, 6) = Cells(X, 5).End(xlToLeft).Value  Next X End Sub       第5例：取不重复的字母 Sub qu() Dim MRG As Range  For Each MRG In Range("a1:d12")    If MRG >= "D" And MRG <= "W" Then     If Application.CountIf([F:F], MRG.Value) = 0 Then      [F65536].End(xlUp).Offset(1, 0) = MRG.Value     End If    End If  Next MRG End Sub      第6例：合并单元格 Sub hb() Dim x  For x = [a65536].End(xlUp).Row To 2 Step -1    If Cells(x, 1) = Cells(x - 1, 1) Then      Application.DisplayAlerts = False        Range(Cells(x, 1), Cells(x - 1, 1)).Merge     Application.DisplayAlerts = True    End If  Next x End Sub     第7例：查找累计值 '倒循环 Sub a() Dim k As Integer, x As Integer, m As Integer k = [c65536].End(xlUp).Row + 1 For m = Application.CountA([a1:a15]) To 2 Step -1    x = 0    Do      k = k - 1      x = x + Cells(k, 3)    Loop Until Cells(k, 1) <> ""  Cells(k, 4) = x  Next m End Sub '正循环 Sub b()   Dim x As Integer   For x = 2 To [a65536].End(xlUp).Row     If Cells(x, 1) <> "" Then       Cells(x, 4) = Application.Sum(Cells(x, 1).Offset(0, 2).Resize(Cells(x, 1).MergeArea.Count)) ' (Cells(x, 1).MergeArea.Offset(, 2))     End If   Next x End Sub Sub af() Dim x, i, a As Integer Sheets("sheet1").Activate x = [b65536].End(xlUp).Row a = x For i = x To 2 Step -1 If Cells(i, 1) <> "" Then Cells(i, 4) = Application.Sum(Range(Cells(i, 3), Cells(a, 3))) a = i - 1 End If Next End Sub [/Power]+7

[此贴子已经被laosanjie于2008-6-18 13:56:06编辑过]

simengzhi · 发表于 2008-6-18 14:51

游客，如果您要查看本帖隐藏内容请回复

+1

[此贴子已经被laosanjie于2008-6-18 17:40:51编辑过]

依米花 · 发表于 2008-6-18 15:45

游客，如果您要查看本帖隐藏内容请回复

+7

[此贴子已经被laosanjie于2008-6-18 17:45:05编辑过]

		自动登录	找回密码
密码			注册

VBA第7讲习题---学员答案上传专贴

补交作业7课作业