【送分结束】循环在VBA中的运用：练习答案及示例代码注释！！

FF7 · 发表于 2012-3-16 22:43

本帖最后由 FF7 于 2012-3-20 12:53 编辑

练习一：将A7:A15的行号输入到A7：A15单元格。 '1分

练习二：在每一个工作表的M2单元格，输出“EP”字样。 '1分

练习三：已知有一列数1，1，2，3，5，8，13，21，…；请问，在这列数中，最接近10000，且小于10000的数是几？ '5分，优秀另加
【练习三补充说明】1，1，2，3，5，8，13，21，…；这个数列是数学中的“裴波那契数列（Fibonacci leonardo)”，这个数列的特点是第三个数等于前两个数的和。所以这个数列中每一个数是确定的，所以最接近10000且小于10000的数是固定值。不是随机数！

练习四：在“循环可以做什么”工作表中，以AW16单元格为中心，以8个单元格为半径，通过变换单元格的背景色画一个近似圆。
'5分，优秀另加

hrpotter · 发表于 2012-3-17 12:01

本帖最后由 hrpotter 于 2012-3-17 13:54 编辑

Sub t1()
Dim rg As Range
For Each rg In Range("a7:a15")
rg = rg.Row
Next rg
End Sub
Sub t2()
Dim SH As Worksheet
For Each SH In Worksheets
SH.Range("m2") = "EP"
Next
End Sub
Sub t3()
Dim i As Integer, j As Integer, k As Integer
i = 1
j = 1
k = 2
Do While k < 10000
i = j
j = k
k = i + j
Loop
MsgBox "在这列数中，最接近10000，且小于10000的数是：" & j
End Sub
Sub t4()
Dim vb As Byte
Dim i As Integer, j As Integer
Application.ScreenUpdating = False
With Sheets("循环可以做什么").Range("aw16")
Do
vb = Int(Rnd * 55 + 1)
Loop Until vb <> .Interior.ColorIndex
For i = -8 To 8
For j = -8 To 8
If i ^ 2 + j ^ 2 <= 64 Then
.Offset(i, j).Interior.ColorIndex = vb
End If
Next
Next
.Interior.ColorIndex = vb
End With
Application.ScreenUpdating = True
End Sub

复制代码

循环在VBA中的运用.rar (70.25 KB, 下载次数: 4)

hrpotter · 发表于 2012-3-17 13:01

Sub t3()
Dim i As Integer, j As Integer, k As Integer
i = 1
j = 1
k = 2
Do While k < 10000
i = j
j = k
k = i + j
Loop
MsgBox "在这列数中，最接近10000，且小于10000的数是：" & j
End Sub

复制代码

那个数是6765?

sunjing-zxl · 发表于 2012-3-17 15:31

本帖最后由 sunjing-zxl 于 2012-3-17 21:28 编辑

Sub 练习1()
Dim i As Long
With Sheets("练习")
For i = 7 To 15
.Cells(i, 1) = .Cells(i, 1).Row
Next i
End With
End Sub
Sub 练习2()
Dim i As Long
For i = 1 To Sheets.Count
Sheets(i).Range("M2") = "EP"
Next i
End Sub
Sub 练习3()
Dim x As Long, y As Long, z As Long
'方法1
x = 1: y = 1: z = 0
Do While z < 10000
z = x + y
x = y: y = z
Loop
MsgBox "小于1万,且最接近1万的数是:" & x, , "方法1"
'方法2
x = 1: y = 1: z = 0
Do
z = x + y
x = y: y = z
Loop While x + y < 10000
MsgBox "小于1万,且最接近1万的数是:" & z, , "方法2"
End Sub
Sub 练习4()
Dim rng As Range, rng1 As Range, T As Double
Dim i As Byte, Ysa As Byte, Ysb As Byte
Sheets("循环可以做什么").Select
With Sheets("循环可以做什么")
Do
Ysa = Int(Rnd * 55 + 1)
Loop Until Ysa <> [AW16].Interior.ColorIndex
Do
Ysb = Int(Rnd * 55 + 1)
Loop Until Ysb <> [AW17].Interior.ColorIndex And Ysb <> Ysa
Set rng = .Range("AV9:AX23")
For i = 1 To 6
Set rng = Union(rng, .Range(.Cells(15 - i, 41 + i), .Cells(17 + i, 41 + i)), .Range(.Cells(15 - i, 57 - i), .Cells(17 + i, 57 - i)))
Next i
For Each rng1 In rng
T = Timer
Do While Timer < T + 0.005
DoEvents
Loop
If rng1.Address = "$AW$16" Then
rng1.Interior.ColorIndex = Ysa
Else
rng1.Interior.ColorIndex = Ysb
End If
Next
End With
End Sub
Sub 返回()
Sheets("练习").Select
End Sub

复制代码

附件:

循环在VBA中的运用练习题-sunjing-zxl.rar (83.53 KB, 下载次数: 3)

cbg2008 · 发表于 2012-3-17 18:53

Sub 添加行号()
Dim X As Integer
For X = 7 To 15
Cells(X, 1) = Cells(X, 1).Row
Next
End Sub

Sub m2()
Dim X As Integer
For X = 1 To Worksheets.Count
Worksheets(X).Range("M2") = "EP"
Next
End Sub

Sub 找10000()
Dim i%, j%, X%
i = 1
j = 1
Do Until X >= 10000
X = i + j
i = j
j = X
Loop
MsgBox "最接近10000且小于10000的数是:  " & i
End Sub

Sub 画圆()
Dim Target As Range, RRange As Range
For Each RRange In Range("ao8:be24")
If ((RRange.Row - 16) ^ 2 + (RRange.Column - 49) ^ 2) ^ 0.5 <= 8 Then
      If Target Is Nothing Then
         Set Target = RRange
      Else
         Set Target = Union(Target, RRange)
      End If
End If
Next
Target.Interior.ColorIndex = 4
Target.ColumnWidth = 1.88
Target.RowHeight = 15
End Sub

qushui · 发表于 2012-3-17 21:45

Sub 练习三()
Dim a%, b%, c%, d%
a = 1: b = 1: c = 2
Do
a = b
b = c
c = a + b
Loop While c < 10000
d = b
End Sub
Sub 练习四()
Dim co As Byte, y%, x%, i%
Sheets(1).Select
Do
co = Int(56 * Rnd()) + 1
Loop Until co <> [aw16].Interior.ColorIndex
For i = 9 To 23
T = Timer
Do While Timer - T < 0.1
DoEvents
Loop
y = Abs(i - 16) + 1
x = Int((64 - y ^ 2) ^ 0.5 + 0.5)
If i = 9 Or i = 23 Then
Range(Cells(i, 48), Cells(i, 50)).Interior.ColorIndex = co
Else
Range(.Cells(i, 50 - x), Cells(i, 48 + x)).Interior.ColorIndex = co
End If
Next i
End Sub
Sub 练习一()
For i = 7 To 15
Cells(i, 1) = i
Next i
End Sub
Sub 练习二()
Dim sh As Worksheet
For Each sh In Sheets
sh.[m2] = "EP"
Next sh
End Sub

复制代码

幽月儿 · 发表于 2012-3-17 22:15

Sub 练习一()
Dim i As Byte
For i = 7 To 15
Cells(i, 1) = i
Next
End Sub
--------------------------------------------------------
Sub 练习二()
Dim sh As Worksheet
For Each sh In Sheets
sh.Range("m2") = "EP"
Next
End Sub
--------------------------------------------------
Sub 练习三()
Dim i As Long, j As Long, c As Long
i = 1
j = 1
Do While c < 10000
c = i + j
i = j
j = c
Loop
MsgBox i
End Sub
-----------------------------------------------------------
Sub 练习四()
Dim r As Range, vb As Byte, T As Double
Do
   vb = Int(Rnd * 55 + 1)
Loop Until vb <> [t19].Interior.ColorIndex

For Each r In [An6:be26]
   T = Timer
   Do While Timer < T + 0.005
      DoEvents
   Loop
   If r.Interior.ColorIndex > 0 Then r.Interior.ColorIndex = vb
Next
End Sub

FF7 · 发表于 2012-3-20 12:51

课件及各个示例的代码注释。
4个练习题的参考答案！！！
详见附件！！

zjcat35 · 发表于 2012-3-20 15:57

原来还可以这样用，学习啦！真强大

sliang28 · 发表于 2012-3-21 15:47

晕，忘记教了，都开帖了。
既然做了，老师给评价下吧！

Sub 输入列号()
Dim i As Integer
For i = 7 To 15
Cells(i, 1) = Cells(i, 1).Row
Next i
End Sub
Sub 输入EP()
Dim i As Integer
For i = 1 To Sheets.Count
Sheets(i).Range("m2") = "EP"
Next i
End Sub
Sub 小于10000()
Dim i!, a(0 To 10000) As Integer
i = 1
a(1) = 1
Do While a(i) <= 10000
i = i + 1
a(i) = (((1 + Sqr(5)) / 2) ^ i - ((1 - Sqr(5)) / 2) ^ i) / Sqr(5) '数列通项式
'Cells(i - 1, "a") = a(i - 1)
Loop
MsgBox "最接近10000的数,且不大于10000的数是：" & a(i - 1)
End Sub
Sub huyuan()
Dim r As Range, vb As Byte, T As Double
Do
vb = Int(Rnd * 55 + 1)
Loop Until vb <> [t19].Interior.ColorIndex
For Each r In Range("AO8:BE24")
T = Timer
Do While Timer < T + 0.001
DoEvents
Loop
If (r.Row - 16) ^ 2 + (r.Column - 49) ^ 2 <= 70 Then r.Interior.ColorIndex = vb
Next
End Sub

复制代码

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

【送分结束】循环在VBA中的运用：练习答案及示例代码注释！！

评分

相关帖子

点评

评分

评分

点评

评分

点评

评分

点评

评分

点评

评分

点评

评分