[接龙...]部分程序代码注释，目录更新20051222

17小菜

CommandBars("My").Delete'删除自定义菜单 Application.CommandBars("Worksheet Menu Bar").Reset 'RemoveCustomMenu恢复系统菜单的各弹出菜单

Long_III

17小菜，你好，请问你也是搞彩票的吗，有些彩票问题还请指教指教。我瞎做了一个双色球的随机取号的代码，待会发上来，请看看，提提意见，先谢了！

17小菜

龙三你好:我也是,随便玩玩而已,碰碰运气

VBA的问题我可要请教大哥了,彩票的问题可以互相研究一下,呵呵

Long_III

20、双色球的随机选择及统计各种奖项。由于好奇，做了一个随机选择号码的东西，发现这样随机选择中奖概率太小了，代码大致注释了一下，主要是给大家看看自定义函数的用处 n9hHnzP1.rar (27.2 KB, 下载次数: 353)

2005-8-22 12:01 上传

点击文件名下载附件
[接龙...]部分程序代码注释，供一些入门选手学习！

Function Hrnd() '产生随机数代码，六个随机数字从1～33中取 Dim i%, s$, a(1 To 6) Dim h As New Collection '利用集合来处理不重复值问题

On Error Resume Next '如果集合里出现重复值就会产生错误，故要用到错误处理 Do i = Int(Rnd() * 33) + 1 h.Add i, CStr(i) Loop Until h.Count = 6 '增加到集合里，一直到集合里的个数等于6个 Err.Clear On Error GoTo 0 '清除错误处理，之后产生的错误还会捕捉到

For i = 1 To 6 a(i) = h(i) Next '把集合里的数字赋值给数组

For i = 1 To 6 s = s & IIf(s = "", "", " ") & Format(Application.Small(a, i), "00") '对数组里的数字排序，并链接在一起 Next

Hrnd = s '给自定义函数赋值，最终结果类似为“03 07 09 16 20 30” End Function

Function M_N_Jiang(s) '根据中奖个数，计算每一个对应的奖级别 Dim a a = Split(arrj, ",") '取"一等奖,二等奖,三等奖,四等奖,五等奖,六等奖"为一个数组 Select Case s Case "6+1" M_N_Jiang = a(0) '6+1对应的是“一等奖”，其他类似 Case "6+0" M_N_Jiang = a(1) Case "5+1" M_N_Jiang = a(2) Case "4+1", "5+0" M_N_Jiang = a(3) Case "4+0", "3+1" M_N_Jiang = a(4) Case "2+1", "1+1", "0+1" M_N_Jiang = a(5) Case Else M_N_Jiang = "" End Select

End Function

17小菜

我做的彩票图表请龙三指点:

在图表版

cfxs001

think you

haoguichun

龙老师真是老师，慢慢的学习，可能这几天其他的网站不去了。从头和有注释的帖子看起。

Long_III

21、自选图片的控制！根据条件找到符合条件的自选图片，然后复制过去！代码为 ：原处为http://club.excelhome.net/viewthread.php?tid=1178123楼，感觉循环的有点多，不知怎么简化，各位朋友有好方法也可以提，谢谢！

INrITMU6.rar (57.7 KB, 下载次数: 372)

2005-8-23 15:41 上传

点击文件名下载附件
[接龙...]部分程序代码注释，供一些入门选手学习！

Private Sub CommandButton1_Click() Dim c As Range, Act As Range Dim p As Shape Dim i%, j%

If MsgBox("请确定是否要更新，如果点击确定，将会全部重新生成图片", vbYesNo, "提示") = vbNo Then Exit Sub '防止误点 Application.ScreenUpdating = False '关闭屏幕更新，加快代码运行速度 Set Act = ActiveCell '记录下当前的单元格，程序运行完之后，再选择当前单元格 For Each p In ActiveSheet.Shapes '删除原先表里有的自定义图片 If p.Type = msoPicture Then p.Delete Next

With Sheets("天气图片") For i = 4 To 16 Step 3 '循环，这里针对了4至16行，可以自己修改 For j = 3 To Cells(i, 256).End(xlToLeft).Column '在列里循环 If Cells(i, j) <> "" Then '不等于空白的时候执行下面的 Set c = .Columns.Find(Cells(i, j), lookat:=xlWhole) '查找，完全匹配查找 If Not c Is Nothing Then '如果找到了 For Each p In .Shapes '在天气图片表里，判断每一个自选图片，是否等于找到单元格c的右侧单元格 If Not Application.Intersect(p.TopLeftCell, c.Offset(0, 1)) Is Nothing Then p.Copy '如果与c单元格右侧一致的话，则复制这个图片 ActiveSheet.Paste '粘贴在工程晴雨表里 Selection.Top = Cells(i, j).Top '设置它的顶点位置 Selection.Left = Cells(i, j).Left Selection.Width = Cells(i, j).Width '设置它的大小，正好与当前单元格一致 Selection.Height = Cells(i, j).Height Exit For '找到之后退出for End If Next p End If End If Next j Next i End With Application.ScreenUpdating = True '恢复屏幕更新 Act.Activate End Sub

dj100

今天才发现这个好贴，万分感谢.

great

log3你好，你编了一个如果这行全是零，则清除掉。现在如果我想做的是如果这个表格中有是零的单元格，我想把这些零都去掉，那又该怎么编呢，谢谢指导。