| 楼主 ryueifu |
我和大家谈谈,用多种方法,制作下面的米字形状,其实呢,是从单元格H8为中心,横竖斜线,都涂上蓝色即可 大家请不要说: 这题目和我无关! 要想提高VBA,就要有揽尽天下事的决心. 不用觉得无聊.如果你是一个vba入门者,学会本贴技术,就掌握了Excel 30%的技能了 我做的很多Excel游戏.基本都是这些个. 要了解我的游戏情况,请打开 看下面的 "动态" 即可.  横竖撇捺八个方向加背景颜色 制作之前,首先新建一个工作簿,将A-O的列宽设置为2.00,使得每个格子都是正方形 方法一: 公式 & 条件格式 由于中心单元格的行号和列号都是8,所以一横一竖所在的所有单元格特征为 第八行 ROW()-8=0 第八列 COLUMN()-8=0 写在一起就是 (ROW()-8)*(COLUMN()-8)=0 类似的,2个斜线的逻辑表达式为 ABS(ROW()-8)=ABS(COLUMN()-8) 那么这个米字的总体表达式是 (ABS(ROW()-8)-ABS(COLUMN()-8))*(ROW()-8)*(COLUMN()-8)=0 明白了以上这些后.我们在A1单元格中写入以下公式 =IF((ABS(ROW()-8)-ABS(COLUMN()-8))*(ROW()-8)*(COLUMN()-8)=0,"*","") 之后,拖拽这个公式到[A1:O15]这个区域 下一步,在条件格式里,写入这个公式,并设置我i底色是蓝色. =A1="*" ok,完事了. 看看动画吧  方法2: VBA遍历实现 2.1双层For...Next配合If 逐个遍历这个区域的每个单元格,把前面写的公式稍微改装一下,就会变成下面的代码.拷贝到模块中运行一下看看效果. 这个双层for循环是常规思路.一般都会这么想. Sub 双层For() Dim r As Integer, c As Integer For r = 1 To 15 For c = 1 To 15 If (Abs(Cells(r, c).Row - 8) - Abs(Cells(r, c).Column - 8)) * (Cells(r, c).Row - 8) * (Cells(r, c).Column - 8) = 0 Then Cells(r, c).Interior.Color = vbBlue End If Next c Next r End Sub 2.2 双层变单层 For Each结构,可以在一个区域内逐个遍历.从左上角到右下角. Sub 单层ForEach() Dim rg As Range For Each rg In Range("A1:O15") If (Abs(rg.Row - 8) - Abs(rg.Column - 8)) * (rg.Row - 8) * (rg.Column - 8) = 0 Then rg.Interior.Color = vbBlue End If Next rg End Sub 相对于上一个sub ,是不是代码的行数减少了? 2.3 For变 Do loop Sub 单层DoLoop() Dim i As Integer, rg As Range i = 1 Do Set rg = Range("A1:O15").Cells(i) If (Abs(rg.Row - 8) - Abs(rg.Column - 8)) * (rg.Row - 8) * (rg.Column - 8) = 0 Then rg.Interior.Color = vbBlue End If If rg.Address(0, 0) = "O15" Then Exit Do i = i + 1 Loop End Sub 和2.2一样的思路,只是循环体换了一下,注意倒数第四行,退出循环的判断.只有遍历到右下角时,方可退出循环 2.4 中心辐射算法 以H8,为中心,向周围的8个方向扩散,从内层到外侧.这个算法不需要考虑行号和列标. 代码很易看懂,但是构思较难. Sub 中心扩展() Dim i As Integer, rg As Range Set rg = Range("H8") For i = 1 To 6 rg.Offset(0, -i).Interior.Color = vbBlue rg.Offset(0, i).Interior.Color = vbBlue rg.Offset(-i, 0).Interior.Color = vbBlue rg.Offset(i, 0).Interior.Color = vbBlue rg.Offset(-i, -i).Interior.Color = vbBlue rg.Offset(-i, i).Interior.Color = vbBlue rg.Offset(i, -i).Interior.Color = vbBlue rg.Offset(i, i).Interior.Color = vbBlue Next i End Sub 上面有8句代码非常类似.下面告诉大家一个改装的方法. 2.5 一个Sub分成多个Sub '''中心扩展简洁版 Sub 中心扩展简洁版() Dim i As Integer, rg As Range For i = 1 To 6 Ofs 0, -i Ofs 0, i Ofs -i, 0 Ofs i, 0 Ofs -i, -i Ofs -i, i Ofs i, -i Ofs i, i Next i End Sub '上面的子函数Ofs定义如下 Public Sub Ofs(r As Integer, j As Integer) Set rg = Range("H8") rg.Offset(r, j).Interior.Color = vbBlue End Sub 是不是更加高效了? 好了,到此为止 最后提醒大家一下,操作每一个sub之前,手工把上次的结果清除掉. 具体看动画"  以上,我用多个方法实现了同一目的. 告诉大家循环和遍历,有哪些想法和思路. 如果大家有其他做法,可以追贴. |
| 2楼 amulee |
总结得不错。 以我个人而言，一个初学者应该从2.4出发思考问题。说实话，想公式要比这个难多了。 2.4再提供一种代码简化
|
| 3楼 ryueifu |
阿木版主,不错. 把我那8行,也总结为一个循环了. 其实我也正愁呢.受教. |
| 4楼 kk学ppt |
(*^__^*) 嘻嘻……，学习了。 |