8月19/20日 Excel函数实战100例 300集Office 2010微视频教程
8月9/10日 Excel函数实战技巧精粹 高效办公必会的Office实战技巧
8月14日 Excel图表之美 网易云课堂-Excel数据透视表应用大全
Excel数据处理与分析实战技巧第1季
查看: 549|回复: 43

零基础VBA 第十期 第七课时作业贴

[复制链接]
发表于 2017-5-18 17:34:27 | 显示全部楼层 |阅读模式
本帖最后由 芬子 于 2017-5-31 16:49 编辑

交作业的要求:

1、不需要附件,只需贴代码,说明你做的是哪道题
2、贴上的代码都需要缩进,并且关键语句要有注释
3、请在添加代码文字,那里添加代码,这样代码要楼层中显得赏心悦目。不知道怎样操作的小伙伴,可以参照看动画。


155656sg9160nc7ozbm6dd.gif
回复

使用道具 举报

发表于 2017-5-18 17:36:49 | 显示全部楼层
本帖最后由 抬头苦干 于 2017-5-19 23:57 编辑

作业07:(2017-05-17 安冬 UID:1700565)
  1. Option Explicit

  2. '1.猜数游戏升级版
  3. Sub Ex1_GuessGamePro()
  4.     Dim i As Long, target As Long, guess As Long
  5.     Dim remark As String
  6.     target = WorksheetFunction.RandBetween(1, 100)
  7.     Do Until guess = target
  8.         guess = Val(InputBox("猜一个 100 以内的正整数:", "猜数", 50))
  9.         If guess < 1 Or guess > 100 Then Exit Sub
  10.         i = i + 1
  11.         If guess < target Then
  12.             MsgBox "猜数 = " & guess & ":小了,小了!", 16, "第 " & i & " 次猜数结果"
  13.         ElseIf guess > target Then
  14.             MsgBox "猜数 = " & guess & ":大了,大了!", 16, "第 " & i & " 次猜数结果"
  15.         End If
  16.     Loop
  17.     Select Case i
  18.         Case Is <= 8:   remark = "天才的头脑,真聪明。"
  19.         Case 9 To 15:   remark = "别伤心,大多数人都和你一样平庸。"
  20.         Case Else:      remark = "笨蛋,你的榆木脑袋该狠狠地敲打敲打了。"
  21.     End Select
  22.     MsgBox "终于猜对了!" & vbCr & "目标数 = 猜数 = " & guess & vbCr & _
  23.            "共猜了 " & i & " 次:" & remark, 64, "结论"
  24. End Sub
复制代码
  1. '2.九九乘法表实现
  2. Sub Ex2_MultiplicationTable()
  3.     Dim iRow As Long, jCol As Long
  4.     For iRow = 1 To 9
  5.         For jCol = 1 To iRow
  6.             Cells(iRow, jCol) = iRow & " × " & jCol & " = " & (iRow * jCol)
  7.         Next jCol
  8.     Next iRow
  9. End Sub
复制代码
  1. '3.出货表练习
  2. Sub Ex3_SubtotalDemo()
  3.     Dim i As Long, j As Long, iEntry As Long, iQuantity As Long
  4.     Dim iMoney As Currency  '金额用货币型
  5.     For i = 2 To Range("J" & Rows.Count).End(xlUp).Row
  6.         iEntry = 0
  7.         iMoney = 0
  8.         iQuantity = 0
  9.         For j = 2 To [A1].End(xlDown).Row
  10.             If Cells(j, 1) = Range("J" & i) Then
  11.                 iEntry = iEntry + 1
  12.                 iMoney = iMoney + Cells(j, 5)
  13.                 iQuantity = iQuantity + Cells(j, 3)
  14.             End If
  15.         Next j
  16.         Range("K" & i) = iMoney
  17.         Range("L" & i) = IIf(iEntry = 0, "", iMoney / iEntry)
  18.         Range("M" & i) = IIf(iQuantity = 0, "", iMoney / iQuantity)
  19.     Next i
  20.     [J1].CurrentRegion.Offset(1, 1).Style = "Currency"
  21. End Sub
复制代码
  1. '4.蛇形填数
  2. Sub Ex4_SnakeFilling()
  3.     '声明四个循环变量:
  4.     Dim iRight As Long, iDown As Long, iLeft As Long, iUp As Long
  5.     '声明阶数、每轮下界、每轮上界、带填入的数:
  6.     Dim order As Long, min As Long, max As Long, N As Long
  7.     '初始化工作:
  8.     [A1].CurrentRegion.EntireColumn.Delete
  9.     order = Val(InputBox("输入方阵阶数:", "定阶", 8))
  10.     If order <= 0 Then Exit Sub
  11.     min = 1
  12.     max = order
  13.     '由外向内逐渐填数:
  14.     Do Until N = order * order
  15.         '向右:
  16.         For iRight = min To max
  17.             N = N + 1
  18.             Cells(min, iRight) = N
  19.         Next iRight
  20.         '向下:
  21.         For iDown = (min + 1) To max
  22.             N = N + 1
  23.             Cells(iDown, max) = N
  24.         Next iDown
  25.         '向左:
  26.         For iLeft = (max - 1) To min Step -1
  27.             N = N + 1
  28.             Cells(max, iLeft) = N
  29.         Next iLeft
  30.         '向上:
  31.         For iUp = (max - 1) To (min + 1) Step -1
  32.             N = N + 1
  33.             Cells(iUp, min) = N
  34.         Next iUp
  35.         '计算下一轮边界:
  36.         max = max - 1
  37.         min = min + 1
  38.     Loop
  39.     '收尾美化:
  40.     Cells(iUp + 1, min - 1).Interior.Color = vbYellow
  41.     [A1].CurrentRegion.EntireColumn.AutoFit
  42.     MsgBox order & " 阶方阵填数完毕!", vbInformation, "蛇形填数"
  43. End Sub
复制代码



点评

很赞  发表于 2017-5-31 14:47
回复 支持 反对

使用道具 举报

发表于 2017-5-18 17:40:03 | 显示全部楼层
  1. Sub 作业1()
  2.     Dim guessNum As Long, i As Long, x As Long
  3.      x = WorksheetFunction.RandBetween(1, 100)
  4.     Do
  5.         guessNum = Val(InputBox("请输入1-100之间的整数"))
  6.         If guessNum < x Then
  7.             MsgBox "小了,小了"
  8.             i = i + 1
  9.         ElseIf guessNum = x Then
  10.             MsgBox "你猜对了"
  11.             i = i + 1
  12.         Else
  13.             MsgBox "大了,大了"
  14.             i = i + 1
  15.         End If
  16.     Loop Until guessNum = x
  17.     If i <= 8 Then
  18.         MsgBox "天才的头脑,真聪明"
  19.     ElseIf i >= 9 And i <= 15 Then
  20.         MsgBox "别伤心,大多数人都和你一样平庸。"
  21.     Else
  22.         MsgBox "笨蛋,你的榆木脑袋该狠狠的敲打敲打了。"
  23.     End If

  24. End Sub

  25. Sub 作业2_矩形()
  26.     Dim i As Long, j As Long
  27.     For i = 1 To 9
  28.         For j = 1 To 9
  29.         Cells(i, j) = i & "*" & j & "=" & i * j
  30.         Next
  31.     Next
  32. End Sub
  33. Sub 作业2_三角形()
  34.     Dim i As Long, j As Long
  35.     For i = 1 To 9
  36.         For j = 1 To i
  37.         Cells(i, j) = i & "*" & j & "=" & i * j
  38.         Next
  39.     Next
  40. End Sub
  41. Sub 作业3()
  42.     Dim 总金额 As Double, 每笔平均 As Double, 平均单价 As Double, 笔数 As Long, 数量 As Long, i As Long, j As Long
  43.     For j = 2 To 6
  44.         For i = 2 To 37
  45.             If Cells(i, 1) = Cells(j, 10) Then
  46.                 总金额 = 总金额 + Cells(i, 5)
  47.                 笔数 = 笔数 + 1
  48.                 数量 = 数量 + Cells(i, 3)
  49.             End If
  50.         Next
  51.         每笔平均 = 总金额 / 笔数
  52.         平均单价 = 总金额 / 数量
  53.         Cells(j, 11) = 总金额
  54.         Cells(j, 12) = 每笔平均
  55.         Cells(j, 13) = 平均单价
  56.     Next
  57. End Sub
  58. Sub 作业4填数()
  59.     Dim i As Long, j As Long, k As Long, sum As Long, num As Long
  60.     j = 1   '当前列
  61.     i = 1   '行数
  62.     k = 0   '循环次料
  63.     num = Val(InputBox("请输入一个整数"))
  64.     Do
  65.     For j = j To num - k
  66.         sum = sum + 1
  67.         Cells(i, j) = sum
  68.     Next
  69.     i = i + 1
  70.     j = j - 1
  71.     For i = i To num - k
  72.         sum = sum + 1
  73.         Cells(i, j) = sum
  74.     Next
  75.     i = i - 1
  76.     j = j - 1
  77.     For j = j To k + 1 Step -1
  78.         sum = sum + 1
  79.         Cells(i, j) = sum
  80.     Next
  81.     i = i - 1
  82.     j = j + 1
  83.     For i = i To k + 2 Step -1
  84.         sum = sum + 1
  85.         Cells(i, j) = sum
  86.     Next
  87.     i = i + 1
  88.     j = j + 1
  89.     k = k + 1
  90.     Loop Until sum = num ^ 2
  91. End Sub
复制代码

点评

赞一个  发表于 2017-5-31 15:00
回复 支持 反对

使用道具 举报

发表于 2017-5-18 17:47:48 | 显示全部楼层
Sub 作业修改猜数游戏()
Dim num As Long, guessNum As Long, i As Long
        num = WorksheetFunction.RandBetween(1, 100)
        Do
        i = i + 1
        guessNum = Val(InputBox("是1-100 哪个数呢?"))
                If guessNum < num Then
                        MsgBox "小笨蛋,小了"
                 ElseIf guessNum > num Then
                         MsgBox "大笨蛋,大了"
                 Else
                         MsgBox "恭喜猜对了"
                 End If
        Loop Until guessNum = num
                MsgBox "你猜了" & i & "次才对"

        If i <= 8 Then
              MsgBox "天才的头脑,你真是太棒了!"
        ElseIf i <= 15 Then
              MsgBox "中等资质,平凡普通,需要继续努力哦~"
        Else
        MsgBox "你的榆木脑袋该敲打敲打了,赶紧抓紧时间联系一下二分法!!!"
        End If
End Sub


Sub 矩形九九乘法表()
Dim i As Integer, j As Integer
For i = 1 To 9
    For j = 1 To 9
        Cells(i, j) = i * j
    Next
Next
End Sub

Sub 三角形九九乘法表()
Dim i As Integer, j As Integer
For i = 1 To 9
    For j = 1 To 9
        If j <= i Then
            Cells(i, j) = i * j
        Else
            Cells(i, j) = ""
        End If
    Next
Next
End Sub

Sub 总金额()
Dim i As Integer, j As Integer
For i = 2 To 37
    For j = 2 To 6
        If Cells(j, 10) = Cells(i, 1) Then
            Cells(j, 11) = Cells(j, 11) + Cells(i, 5)
        End If
    Next
Next
End Sub


Sub 平均价格()
Dim i As Integer, j As Integer
For i = 2 To 37
    For j = 2 To 6
        If Cells(j, 10) = Cells(i, 1) Then
            Cells(j, 14) = Cells(j, 14) + 1
            Cells(j, 12) = Cells(j, 11) / Cells(j, 14)
        End If
    Next
Next
End Sub


Sub 平均单价()
Dim i As Integer, j As Integer
For i = 2 To 37
    For j = 2 To 6
        If Cells(j, 10) = Cells(i, 1) Then
            Cells(j, 15) = Cells(j, 15) + Cells(i, 3)
            Cells(j, 13) = Cells(j, 11) / Cells(j, 15)
        End If
    Next
Next
End Sub


Sub 蛇形()
Dim i As Integer, j As Integer
For i = 1 To 8
    For j = 1 To 8
        If i = 1 Then
            Cells(i, j) = Cells(i, j) + j
        ElseIf i > 1 And i < 8 And j = 8 Then
            Cells(i, 8) = Cells(1, 8) + i - 1
        ElseIf i = 8 And j > 1 Then
            Cells(8, j) = 23 - j
        ElseIf i > 1 And j = 1 Then
            Cells(i, 1) = 30 - i
        ElseIf j > 1 And j < 8 And i = 2 Then
            Cells(2, j) = 28 + j - 1
        ElseIf i > 2 And i < 8 And j = 7 Then
            Cells(i, 7) = 34 + i - 2
        ElseIf j > 1 And j < 7 And i = 7 Then
            Cells(7, j) = 44 - j + 2
        ElseIf i > 2 And i < 7 And j = 2 Then
            Cells(i, 2) = 48 - i + 3
        ElseIf j > 2 And j < 7 And i = 3 Then
            Cells(3, j) = 48 + j - 2
        ElseIf i > 3 And i < 7 And j = 6 Then
            Cells(i, 6) = 52 + i - 3
        ElseIf j > 2 And j < 6 And i = 6 Then
            Cells(6, j) = 58 - j + 3
        ElseIf i > 3 And i < 6 And j = 3 Then
            Cells(i, 3) = 58 + 2 - i + 4
        ElseIf j > 3 And j < 6 And i = 4 Then
            Cells(4, j) = 60 + j - 3
        Else
            Cells(i, j) = 63 - j + 5
        End If
    Next
Next
End Sub

点评

出货的 写成一个程序,少掉很多循环 蛇形这个 可以参考其他学员的  发表于 2017-5-31 15:21
回复 支持 反对

使用道具 举报

发表于 2017-5-18 20:32:21 | 显示全部楼层
本帖最后由 amumua 于 2017-5-19 08:21 编辑
  1. '作业1,猜数游戏
  2. Sub gusnum()
  3.     Dim gusn As Long, num As Long, gt As Long
  4.     num = WorksheetFunction.RandBetween(1, 100)
  5.     Do
  6.         gusn = InputBox("猜一个数(1-100的正整数)")
  7.         gt = gt + 1
  8.         If gusn > num Then
  9.             MsgBox "大了大了!"
  10.         ElseIf gusn < num Then
  11.             MsgBox "小了小了!"
  12.         Else
  13.             If gt <= 8 Then
  14.                 MsgBox "天才的头脑,真聪明"
  15.                 Exit Do
  16.             ElseIf gt <= 15 Then
  17.                 MsgBox "别伤心,大多数人都和你一样平庸"
  18.                 Exit Do
  19.             Else
  20.                 MsgBox "笨蛋,你的榆木脑袋该狠狠敲打敲打了"
  21.                 Exit Do
  22.             End If
  23.         End If
  24.     Loop
  25. End Sub

  26. '作业2,九九乘法表
  27. Sub pro()
  28.     Dim i As Long, j As Long
  29.     For i = 1 To 9
  30.         For j = 1 To 9
  31.             If i >= j Then
  32.                 Cells(i, j) = j & "x" & i & "=" & i * j
  33.             Else
  34.                 Exit For
  35.             End If
  36.         Next
  37.     Next
  38. End Sub
  39. '作业,出货表练习
  40. Sub stable()
  41.     Dim summ As Long, sumn As Long, sumq As Long
  42.     Dim i As Long, j As Long
  43.    
  44.     i = 1
  45.     Do
  46.         j = 1
  47.         i = i + 1
  48.         Do
  49.             j = j + 1
  50.             If Cells(j, 1) = Cells(i, 10) Then
  51.                 summ = summ + Cells(j, 5)
  52.                 sumn = sumn + Cells(j, 3)
  53.                 sumq = sumq + 1
  54.             End If
  55.         Loop Until Cells(j, 1) = ""
  56.         Cells(i, 11) = summ
  57.         Cells(i, 12) = Round(summ / sumq, 2)
  58.         Cells(i, 13) = Round(summ / sumn, 2)
  59.         summ = 0
  60.         sumn = 0
  61.         sumq = 0
  62.         
  63.     Loop Until i = 6
  64. End Sub

  65. Sub snake()
  66.     Dim i As Long, j As Long, lo As Long, m As Long, n As Long
  67.     lo = InputBox("请输入方阵的边长")
  68.     Cells(1, 1) = 1
  69.    
  70.         
  71.         m = 1
  72.         n = lo
  73.     If lo Mod 2 = 1 Then
  74.         Do Until m = (lo + 1) / 2
  75.             i = m
  76.             For j = (m + 1) To n
  77.                 Cells(i, j) = Cells(i, j - 1) + 1
  78.             Next
  79.             j = n
  80.             For i = (m + 1) To n
  81.                 Cells(i, j) = Cells(i - 1, j) + 1
  82.             Next
  83.             i = n
  84.             For j = (n - 1) To m Step -1
  85.                 Cells(i, j) = Cells(i, j + 1) + 1
  86.             Next
  87.             j = m
  88.             For i = (n - 1) To (m + 1) Step -1
  89.                 Cells(i, j) = Cells(i + 1, j) + 1
  90.             Next
  91.             Cells(m + 1, m + 1) = Cells(m + 1, m) + 1
  92.             m = m + 1
  93.             n = n - 1
  94.         Loop
  95.     Else
  96.         Do Until m = lo / 2
  97.             i = m
  98.             For j = (m + 1) To n
  99.                 Cells(i, j) = Cells(i, j - 1) + 1
  100.             Next
  101.             j = n
  102.             For i = (m + 1) To n
  103.                 Cells(i, j) = Cells(i - 1, j) + 1
  104.             Next
  105.             i = n
  106.             For j = (n - 1) To m Step -1
  107.                 Cells(i, j) = Cells(i, j + 1) + 1
  108.             Next
  109.             j = m
  110.             For i = (n - 1) To (m + 1) Step -1
  111.                 Cells(i, j) = Cells(i + 1, j) + 1
  112.             Next
  113.             Cells(m + 1, m + 1) = Cells(m + 1, m) + 1
  114.             m = m + 1
  115.             n = n - 1
  116.         Loop
  117.         Cells(lo / 2, lo / 2 + 1) = lo ^ 2 - 2
  118.         Cells(lo / 2 + 1, lo / 2 + 1) = lo ^ 2 - 1
  119.         Cells(lo / 2 + 1, lo / 2) = lo ^ 2
  120.     End If
  121. End Sub
复制代码

点评

乘法表第二层for 可以是 j = 1 to i  发表于 2017-5-31 15:40
回复 支持 反对

使用道具 举报

发表于 2017-5-19 10:10:38 | 显示全部楼层
Sub 猜数()
Dim num As Long, guessnum As Long, i As Long
num = WorksheetFunction.RandBetween(1, 100)
Do
guessnum = InputBox("请输入1-100之间的一个整数来猜")
i = i + 1
If guessnum > num Then
MsgBox "大了,大了"
Else
MsgBox "小了,小了"
End If
Loop Until guessnum = num
MsgBox i
If i <= 8 Then
MsgBox "天才的头脑,真聪明"
ElseIf i >= 9 And i <= 15 Then
MsgBox "别伤心,大多数人都和你一样平庸"
Else
MsgBox "笨蛋,你的榆木脑袋该狠狠的敲打敲打了。"
End If

End Sub

点评

猜数 如果我猜对了也会提示小了小了  发表于 2017-5-31 15:41
回复 支持 反对

使用道具 举报

发表于 2017-5-19 10:11:20 | 显示全部楼层
Sub 乘法表()
Dim a As Long, b As Long, c As Long
For a = 1 To 9
For b = 1 To 9
c = a * b
Cells(a, b) = a & "*" & b & "=" & c
If a <= b Then Exit For
Next
Next

End Sub
回复 支持 反对

使用道具 举报

发表于 2017-5-19 11:45:04 | 显示全部楼层
  1. Sub 出货表()
  2.     Dim I As Long, J As Long, K As Long, 数量 As Long
  3.     For I = 2 To 6
  4.     K = 0
  5.     数量 = 0
  6.         For J = 2 To 37
  7.             If Cells(J, 1) = Cells(I, 10) Then
  8.                 Cells(I, 11) = Cells(I, 11) + Cells(J, 5)
  9.                 K = K + 1
  10.                 数量 = 数量 + Cells(J, 3)
  11.             End If
  12.         Next
  13.     Cells(I, 12) = Cells(I, 11) / K
  14.     Cells(I, 13) = Cells(I, 11) / 数量
  15.     Next
  16. End Sub
复制代码
  1. Sub 猜数()
  2.     Dim INUM As Long, GNUM As Long, I As Long
  3.     GNUM = WorksheetFunction.RandBetween(1, 100)
  4.     Do
  5.     INUM = InputBox("请输入1-100之间的整数")
  6.         If INUM > GNUM Then
  7.             MsgBox "大了大了"
  8.         ElseIf INUM < GNUM Then
  9.             MsgBox "小了小了"
  10.         End If
  11.     I = I + 1
  12.     Loop Until INUM = GNUM
  13.     Select Case I
  14.         Case Is <= 8
  15.         MsgBox I & "次你就猜对了,天才的头脑,真聪明!"
  16.         Case Is <= 15
  17.         MsgBox I & "次你猜对了,别伤心,大多数人和你一样!"
  18.         Case Is > 15
  19.         MsgBox I & "次你才猜对了,你的榆木脑袋该狠狠的敲打敲打了!"
  20.     End Select
  21. End Sub
复制代码
  1. Sub 九九乘法表()
  2.     Dim I As Long, J As Long, SUM As Long
  3.     For I = 1 To 9
  4.         For J = 1 To I
  5.         SUM = I * J
  6.         Cells(I, J) = I & "×" & J & "=" & SUM
  7.         Next
  8.     Next
  9. End Sub
复制代码


点评

棒棒哒  发表于 2017-5-31 15:48
回复 支持 反对

使用道具 举报

发表于 2017-5-19 12:24:07 | 显示全部楼层
本帖最后由 行动的蜗牛 于 2017-5-24 13:43 编辑
  1. Sub 作业1_猜数游戏()
  2.     Dim i As Long, guess As Long, random_number As Long
  3.     random_number = Application.WorksheetFunction.RandBetween(1, 100)
  4.     Do
  5.         guess = Val(InputBox("请输入您猜的数"))
  6.             If guess > random_number Then
  7.                 MsgBox "大了,大了"
  8.             ElseIf guess < random_number Then
  9.                 MsgBox "小了,小了"
  10.             End If
  11.                 i = i + 1
  12.     Loop Until guess = random_number
  13.     Select Case i
  14.         Case 1 To 8
  15.             MsgBox "恭喜,你只用了" & i & "次就猜对了。天才的头脑,真聪明。"
  16.         Case 9 To 15
  17.             MsgBox "你用了" & i & "次猜对了,别伤心,大多数人和你一样平庸。"
  18.         Case Is > 15
  19.             MsgBox "猜了" & i & "次才猜中,笨蛋,你的榆木脑袋该狠狠的敲打敲打了。"
  20.         End Select
  21. End Sub


  22. Sub 作业2_九九乘法表()
  23. Dim i As Long, j As Long
  24.     For i = 1 To 9
  25.         For j = 1 To i
  26.         Cells(i, j) = j & "*" & i & "=" & i * j
  27.         Next
  28.     Next
  29. End Sub


  30. Sub 作业3_出货表()
  31. Dim i As Long, j As Long, sum As Double, num As Long, sum1 As Long
  32.         For j = 2 To 6
  33.             sum = 0
  34.             num = 0
  35.             sum1 = 0
  36.             For i = 2 To Range("a1").End(xlDown).Row
  37.                 If Cells(i, 1) = Cells(j, 10) Then
  38.                     sum = Cells(i, 5) + sum
  39.                     num = num + 1
  40.                     sum1 = sum1 + Cells(i, 3)
  41.                     Range("k" & j) = sum
  42.                     Range("L" & j) = Round(sum / num, 2)
  43.                     Range("M" & j) = Round(sum / sum1, 2)
  44.                 End If
  45.             Next
  46.          Next
  47. End Sub
复制代码



点评

不错  发表于 2017-5-31 15:50
回复 支持 反对

使用道具 举报

发表于 2017-5-19 12:41:17 | 显示全部楼层
  1. Sub 出货表()
  2.     Dim i As Long, j As Long, K As Long, l As Long, m As Long  ' 为笔数,M为总数量
  3.     K = 2
  4.     Cells(2, 10) = Cells(2, 1)
  5.     For i = 3 To 37
  6.         For j = 2 To 36
  7.              If Cells(i, 1) = Cells(j, 1) Then Exit For
  8.              If j = i - 1 Then Exit For
  9.         Next
  10.         If Cells(i, 1) <> Cells(j, 1) Then
  11.                 K = K + 1
  12.                 Cells(K, 10) = Cells(i, 1)
  13.         End If
  14.     Next
  15.     For K = 2 To 6
  16.         l = 0
  17.         m = 0
  18.         For i = 2 To 37
  19.             If Cells(K, 10) = Cells(i, 1) Then
  20.                 Cells(K, 11) = Cells(K, 11) + Cells(i, 5)
  21.                 l = l + 1
  22.                 m = m + Cells(i, 3)
  23.              End If
  24.         Next
  25.         Cells(K, 12) = Cells(K, 11) / l
  26.         Cells(K, 13) = Cells(K, 11) / m
  27.     Next
  28.    
  29.    
  30. End Sub
  31. Sub 蛇形填数()
  32. Dim i As Long, j As Long, K As Long, l As Long, m As Long 'ijlkmnop分别为4个区域的行列坐标,num 为与列子中与8 同样作用的数字
  33. Dim n As Long, o As Long, p As Long, num As Long, sum As Long 'sum 为与实例中1-64类似的数字
  34.     num = InputBox("请输入数字")
  35.         For i = 1 To num \ 2
  36.             For j = i To num - i
  37.                 sum = sum + 1
  38.                 Cells(i, j) = sum
  39.             Next
  40.             For l = i To num - i
  41.                 K = num - i + 1
  42.                 sum = sum + 1
  43.                 Cells(l, K) = sum
  44.             Next
  45.             For n = num - i + 1 To i + 1 Step -1
  46.                 m = num - i + 1
  47.                 sum = sum + 1
  48.                 Cells(m, n) = sum
  49.             Next
  50.             For o = num - i + 1 To i + 1 Step -1
  51.                 p = i
  52.                 sum = sum + 1
  53.                 Cells(o, p) = sum
  54.                 Next
  55.             Next
  56.    
  57. End Sub
  58. Sub 乘法表()
  59.     Dim i As Long, j As Long
  60.     For i = 1 To 9
  61.         For j = 1 To 9
  62.             Cells(i, j) = j & "*" & i & "=" & i * j
  63.             If i < j Then Cells(i, j) = ""
  64.             
  65.         Next
  66.     Next
  67. End Sub
  68. Sub 猜数字()
  69.   Dim num As Long, guessNum As Long, i As Long
  70.   num = WorksheetFunction.RandBetween(1, 100)
  71.   Do
  72.         i = i + 1
  73.         guessNum = Val(InputBox("请输入1-100之间的一个整数来猜"))
  74.         If guessNum > num Then
  75.             MsgBox "大了,大了"
  76.         ElseIf guessNum < num Then
  77.             MsgBox "小了,小了"
  78.         End If
  79.   Loop Until guessNum = num
  80.   If i <= 8 Then
  81.       MsgBox "天才的头脑,真聪明"
  82.   ElseIf i >= 9 And i <= 15 Then
  83.       MsgBox "别伤心,大多数人都和你一样平庸"
  84.   Else
  85.       MsgBox "笨蛋,你的榆木脑袋该狠狠地敲打敲打了"
  86.   End If
  87.   
  88. End Sub
复制代码

点评

不错  发表于 2017-5-31 15:55
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 入学

本版积分规则

关闭

站长推荐上一条 /2 下一条

快速回复 返回顶部 返回列表