白话Excel函数公式 Office易学宝微视频教程合集(Excel+Word+PPT)
笨办法学VBA(从入门到精通) 高效办公必会的Office实战技巧
财务总监的Excel私房课 网易云课堂-Excel数据透视表应用大全
Excel图表神技
查看: 385|回复: 3

练习6

[复制链接]
发表于 2015-8-28 15:14:31 | 显示全部楼层 |阅读模式
本帖最后由 临时户口 于 2015-9-8 12:41 编辑

本题感谢鲨鱼老师提供,本题截止到2015年9-5日
QQ20140824190511.png

数字接龙.zip

34.76 KB, 下载次数: 11

回复

使用道具 举报

发表于 2015-8-28 17:56:38 | 显示全部楼层
  1. Sub aa()
  2.     Dim bgin&, i&, j&
  3.     Application.ScreenUpdating = False '屏幕更新关闭
  4.     With Sheets("练习")
  5.         bgin = .Range("a15").Value '设置A15单元格的值赋予给bgin变量
  6.         .Range("a2:j11").ClearContents '清除A12:J11单元格区域的值
  7.         .Range("a2:j11").Interior.Pattern = xlNone '将A12:J11单元格区域背景颜色设置为无
  8.         For j = 1 To 10 '列从1循环到10
  9.             If j Mod 2 = 1 Then '如果为奇数列
  10.                 For i = 1 To 10 '行从1循环到10
  11.                     .Cells(i + 1, j) = bgin + i + (j - 1) * 10 - 1 '设置当前单元格的值
  12.                     If .Cells(i + 1, j) Like "*2*" Then '如果当前单元格的值包含2
  13.                         .Cells(i + 1, j).Interior.ColorIndex = .Cells(15, 2).Interior.ColorIndex
  14.                         '将B15单元格的背景颜色赋予给当前单元格
  15.                     End If
  16.                 Next
  17.             Else
  18.                 For i = 10 To 1 Step -1 '行从10循环到1
  19.                     .Cells(i + 1, j) = bgin + 10 * j - i '设置当前单元格的值
  20.                     If .Cells(i + 1, j) Like "*2*" Then '如果当前单元格包含2
  21.                         .Cells(i + 1, j).Interior.ColorIndex = .Cells(15, 2).Interior.ColorIndex
  22.                         '将B15单元格的背景颜色赋予给当前单元格
  23.                     End If
  24.                 Next
  25.             End If
  26.         Next
  27.     End With
  28.     Application.ScreenUpdating = True '屏幕更新开启
  29. End Sub
复制代码

点评

填充颜色单独写个模块根据清晰  发表于 2015-9-8 11:26

评分

参与人数 1登攀 +30 收起 理由
临时户口 + 30

查看全部评分

回复 支持 反对

使用道具 举报

发表于 2015-9-1 10:30:36 | 显示全部楼层
本帖最后由 slg36 于 2015-9-4 13:19 编辑

方法一:
  1. Sub 数字接龙()
  2.     Dim i As Integer, j As Integer, m As Long
  3.     Dim rng As Range
  4.     Application.ScreenUpdating = False
  5.     With Sheets("练习")
  6.         .Range("a2:j11").ClearContents                                      '清除A2:J11内容
  7.         .Range("a2:j11").Interior.Color = xlNone                            '清除A2:J11颜色
  8.         m = Range("a15").Value - 1                                          '获取初始值
  9.         For i = 1 To 10
  10.             If i Mod 2 = 1 Then                                             '奇数列循环
  11.                 For j = 2 To 11
  12.                     m = m + 1
  13.                     Cells(j, i) = m
  14.                 Next j
  15.             Else
  16.                 For j = 11 To 2 Step -1                                     '偶数列循环
  17.                     m = m + 1
  18.                     Cells(j, i) = m
  19.                 Next j
  20.             End If
  21.         Next i
  22.         For Each rng In .Range("a2:j11")
  23.             If InStr(CStr(rng.Value), "2") > 0 Then
  24.                 rng.Interior.ColorIndex = Range("b15").Interior.ColorIndex  '包含2的单元格填充相应颜色
  25.             End If
  26.         Next
  27.     End With
  28.     Application.ScreenUpdating = True
  29. End Sub
复制代码
方法二:
  1. Sub 数字接龙1()
  2.     Dim i As Integer, j As Integer, m As Long
  3.     Dim arr(1 To 10, 1 To 10), rng As Range
  4.     Application.ScreenUpdating = False
  5.     With Sheets("练习")
  6.         .Range("a2:j11").ClearContents                                      '清除A2:J11内容
  7.         .Range("a2:j11").Interior.Color = xlNone                            '清除A2:J11颜色
  8.         m = Range("a15").Value - 1                                          '获取初始值
  9.         For i = 1 To 10
  10.             For j = 1 To 10 Step 2                                          '奇数列循环
  11.                 arr(i, j) = m + i + (j - 1) * 10
  12.             Next j
  13.             For j = 2 To 10 Step 2                                          '偶数列循环
  14.                 arr(i, j) = m + 1 - i + j * 10
  15.             Next j
  16.         Next i
  17.          .Range("A2:J11") = arr
  18.         For Each rng In .Range("a2:j11")
  19.             If InStr(CStr(rng.Value), "2") > 0 Then
  20.                 rng.Interior.ColorIndex = Range("b15").Interior.ColorIndex  '包含2的单元格填充相应颜色
  21.             End If
  22.         Next
  23.     End With
  24.     Application.ScreenUpdating = True
  25. End Sub
复制代码


评分

参与人数 1登攀 +40 收起 理由
临时户口 + 40

查看全部评分

回复 支持 反对

使用道具 举报

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

本版积分规则

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