Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 4479|回复: 13

[已解决]VBA求助

[复制链接]
发表于 2015-8-19 15:31 | 显示全部楼层 |阅读模式
我做了一个表格,又请人按我的思路做了修改,但是现在还需要进一步修改,请各位大侠帮忙。

1、号码统计   该表中增添  近期中出五码   近期中出六码  框,需要对对应的VBA作出修改
2、点 近期中出四码 后  会出现  和值输入栏  ,该和值输入栏和值我想固定为63,64,65,66,67,68,69,70,71,72这10个。
(2015.08.19)固定和值组码.zip (481.63 KB, 下载次数: 5)
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
 楼主| 发表于 2015-8-19 15:35 | 显示全部楼层
file:///C:\Documents and Settings\Administrator\My Documents\Tencent Files\756610431\Image\C2C\NFNXU}R@E8~{U(WK]{U`AQ0.jpg

NFNXU}R@E8~{U(WK]{U`AQ0.jpg

5I12[SBB_I5RCF~XA1N6K%P.jpg




回复

使用道具 举报

 楼主| 发表于 2015-8-19 15:43 | 显示全部楼层
四码和值只包含63,64,65,66,67,68,69,70,71,72十个当中的1-6个。
回复

使用道具 举报

发表于 2015-8-19 16:07 | 显示全部楼层
给个五码的代码。六码再多一层循环就行了。
  1. Sub 五码()
  2.     Dim x As Integer
  3.     x = InputBox("请输入你需要的五码和值,在15-155之间", "和值输入", 15)
  4.     If x < 6 Or x > 126 Then MsgBox "您输入的和值超出范围": Exit Sub
  5.    
  6.     c = [IV1].End(xlToLeft).Column
  7.     arr = Range([J1], Cells(1, c))
  8.     v = UBound(arr, 2)
  9.     ReDim brr(1 To 3000, 1 To 7)
  10.    
  11.     [J6:AI3000].ClearContents
  12.     For i = 1 To v - 4
  13.         For j = i + 1 To v - 3
  14.             For k = j + 1 To v - 2
  15.                 For n = k + 1 To v - 1
  16.                     For m = n + 1 To v
  17.                         If x = arr(1, i) + arr(1, j) + arr(1, k) + arr(1, n) + arr(1, m) Then
  18.                             p = p + 1
  19.                             brr(p, 1) = arr(1, i)
  20.                             brr(p, 2) = arr(1, j)
  21.                             brr(p, 3) = arr(1, k)
  22.                             brr(p, 4) = arr(1, n)
  23.                             brr(p, 5) = arr(1, m)
  24.                             brr(p, 7) = "五码和值为" & x
  25.                         End If
  26.     Next: Next: Next: Next: Next
  27.     If p > 0 Then [J6].Resize(p, 7) = brr
  28. End Sub
复制代码

(2015.08.19)固定和值组码.rar

493.25 KB, 下载次数: 6

回复

使用道具 举报

 楼主| 发表于 2015-8-19 16:17 | 显示全部楼层
grf1973 发表于 2015-8-19 16:07
给个五码的代码。六码再多一层循环就行了。

谢谢你,和值范围的问题能解决吗?
回复

使用道具 举报

发表于 2015-8-19 16:31 | 显示全部楼层
  1. Sub 五码()
  2.     Dim x As Integer
  3.     s = "63,64,65,66,67,68,69,70,71,72"          '指定范围
  4.     x = InputBox("请输入你需要的五码和值(指定范围:" & s & ")", "和值输入", 63)
  5.     If InStr("," & s & ",", "," & x & ",") = 0 Then MsgBox "请在指定范围内输入": Exit Sub
  6.     c = [IV1].End(xlToLeft).Column
  7.     arr = Range([J1], Cells(1, c))
  8.     v = UBound(arr, 2)
  9.     ReDim brr(1 To 3000, 1 To 7)
  10.    
  11.     [J6:AI3000].ClearContents
  12.     For i = 1 To v - 4
  13.         For j = i + 1 To v - 3
  14.             For k = j + 1 To v - 2
  15.                 For n = k + 1 To v - 1
  16.                     For m = n + 1 To v
  17.                         If x = arr(1, i) + arr(1, j) + arr(1, k) + arr(1, n) + arr(1, m) Then
  18.                             p = p + 1
  19.                             brr(p, 1) = arr(1, i)
  20.                             brr(p, 2) = arr(1, j)
  21.                             brr(p, 3) = arr(1, k)
  22.                             brr(p, 4) = arr(1, n)
  23.                             brr(p, 5) = arr(1, m)
  24.                             brr(p, 7) = "五码和值为" & x
  25.                         End If
  26.     Next: Next: Next: Next: Next
  27.     If p > 0 Then [J6].Resize(p, 7) = brr
  28. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2015-8-19 16:39 | 显示全部楼层
grf1973 发表于 2015-8-19 16:31

刚才的意思没有说明白。
1是出五码,
2是五码中任意四码的和在62-73之间.
看看能不能实现。
再次感谢。
回复

使用道具 举报

发表于 2015-8-19 16:58 | 显示全部楼层
  1. Sub 五码()
  2.     x = InputBox("请输入你需要的五码和值范围", "和值输入", "63-72")
  3.     x1 = Split(x, "-")(0): x2 = Split(x, "-")(1)
  4.     If Val(x1) < 63 Or Val(x2) > 72 Then MsgBox "请在指定范围内输入": Exit Sub
  5.     c = [IV1].End(xlToLeft).Column
  6.     arr = Range([J1], Cells(1, c))
  7.     v = UBound(arr, 2)
  8.     ReDim brr(1 To 30000, 1 To 7)
  9.    
  10.     [J6:AI30000].ClearContents
  11.     For i = 1 To v - 4
  12.         For j = i + 1 To v - 3
  13.             For k = j + 1 To v - 2
  14.                 For n = k + 1 To v - 1
  15.                     For m = n + 1 To v
  16.                         s = arr(1, i) + arr(1, j) + arr(1, k) + arr(1, n) + arr(1, m)
  17.                         If s >= Val(x1) And s <= Val(x2) Then
  18.                             p = p + 1
  19.                             brr(p, 1) = arr(1, i)
  20.                             brr(p, 2) = arr(1, j)
  21.                             brr(p, 3) = arr(1, k)
  22.                             brr(p, 4) = arr(1, n)
  23.                             brr(p, 5) = arr(1, m)
  24.                             brr(p, 7) = "五码和值为" & s
  25.                         End If
  26.     Next: Next: Next: Next: Next
  27.     If p > 0 Then [J6].Resize(p, 7) = brr
  28. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2015-8-19 17:14 | 显示全部楼层
grf1973 发表于 2015-8-19 16:58

这还不是我想要的结果。
第一步:出五码
第二步:五码中任意四码的和值范围是62-73
第三步:所保留的五码必须包含左边最后一行6码中的1-2个。
余下的五码再和未出的号码匹配就是双色球的开奖号范围应该在2万注左右。
希望你能帮我想想办法。不胜感谢。
回复

使用道具 举报

发表于 2015-8-20 11:35 | 显示全部楼层
  1. Sub 五码()
  2.     x = InputBox("请输入你需要的五码和值范围", "和值输入", "63-72")
  3.     x1 = Split(x, "-")(0): x2 = Split(x, "-")(1)
  4.     If Val(x1) < 63 Or Val(x2) > 72 Then MsgBox "请在指定范围内输入": Exit Sub
  5.     c = [IV1].End(xlToLeft).Column
  6.     arr = Range([J1], Cells(1, c))
  7.     v = UBound(arr, 2)
  8.     ReDim brr(1 To 30000, 1 To 7)
  9.    
  10.     crr = Cells([a65536].End(3).Row, 1).Resize(1, 6)   '左边最下面一行(用于比较产生五码必须是其中1-2个)
  11.     Set d = CreateObject("scripting.dictionary")
  12.     For i = 1 To UBound(crr, 2)
  13.         d(crr(1, i)) = ""
  14.     Next
  15.    
  16.     [J6:AI30000].ClearContents
  17.     For i = 1 To v - 4             '第一步:五重循环取五码(同时判断符合条件数是否为1-2个)
  18.         If d.exists(arr(1, i)) Then kk = kk + 1       '如果是左边最下面一行中的数,kk+1
  19.         For j = i + 1 To v - 3
  20.             If d.exists(arr(1, j)) Then kk = kk + 1       '如果是左边最下面一行中的数,kk+1
  21.             For k = j + 1 To v - 2
  22.                 If d.exists(arr(1, k)) Then kk = kk + 1       '如果是左边最下面一行中的数,kk+1
  23.                 If kk > 2 Then kk = 0: Exit For   '符合条件超过2个,退出循环
  24.                 For n = k + 1 To v - 1
  25.                     If d.exists(arr(1, n)) Then kk = kk + 1       '如果是左边最下面一行中的数,kk+1
  26.                     If kk > 2 Then kk = 0: Exit For      '符合条件超过2个,退出循环
  27.                     For m = n + 1 To v
  28.                         If d.exists(arr(1, k)) Then kk = kk + 1       '如果是左边最下面一行中的数,kk+1
  29.                         If kk > 2 Or kk = 0 Then kk = 0: Exit For        '符合条件超过2个或1个没有,退出循环
  30.                         smin = arr(1, i) + arr(1, j) + arr(1, k) + arr(1, n)   '前4码相加,最小值
  31.                         smax = arr(1, j) + arr(1, k) + arr(1, n) + arr(1, m)         '后4码相加,最大值
  32.                         If smin >= Val(x1) And smax <= Val(x2) Then           '第二步:任意四码相加和在取值范围内
  33.                             p = p + 1
  34.                             brr(p, 1) = arr(1, i)
  35.                             brr(p, 2) = arr(1, j)
  36.                             brr(p, 3) = arr(1, k)
  37.                             brr(p, 4) = arr(1, n)
  38.                             brr(p, 5) = arr(1, m)
  39.                             brr(p, 7) = "左边最后一行六码中有" & kk & "个,任意四码和值最小为" & smin & ",最大为" & smax
  40.                         End If
  41.     Next: Next: Next: Next: Next
  42.     If p > 0 Then [J6].Resize(p, 7) = brr
  43. End Sub
复制代码
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 17:16 , Processed in 0.809296 second(s), 9 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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