[已解决]VBA求助

grf1973

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
    

复制代码

grf1973

第28句改成  If d.exists(arr(1, m)) Then kk = kk + 1

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, m)) 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
    

复制代码

grf1973

上午代码有点小问题，修改如下：

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. aa:
    
18.     For i = 1 To v - 4             '第一步：五重循环取五码（同时判断符合条件数是否为1-2个）
    
19.         If d.exists(arr(1, i)) Then ka = 1 Else ka = 0    '如果是左边最下面一行中的数，ka=1
    
20.         For j = i + 1 To v - 3
    
21.             If d.exists(arr(1, j)) Then kb = ka + 1 Else kb = ka    '如果是左边最下面一行中的数，kk+1
    
22.             For k = j + 1 To v - 2
    
23.                 If d.exists(arr(1, k)) Then kc = kb + 1 Else kc = kb    '如果是左边最下面一行中的数，kk+1
    
24.                 If kc <= 2 Then    '符合条件，退出循环
    
25.                     For n = k + 1 To v - 1
    
26.                         If d.exists(arr(1, n)) Then kd = kc + 1 Else kd = kc    '如果是左边最下面一行中的数，kk+1
    
27.                         If kd <= 2 Then     '符合条件超过2个，退出循环
    
28.                             For m = n + 1 To v
    
29.                                 If d.exists(arr(1, m)) Then ke = kd + 1 Else ke = kd    '如果是左边最下面一行中的数，kk+1
    
30.                                 If ke > 2 Or ke = 0 Then Exit For         '符合条件超过2个或1个没有，退出循环
    
31.                                 smin = arr(1, i) + arr(1, j) + arr(1, k) + arr(1, n)   '前4码相加，最小值
    
32.                                 smax = arr(1, j) + arr(1, k) + arr(1, n) + arr(1, m)         '后4码相加，最大值
    
33.                                 If smin >= Val(x1) And smax <= Val(x2) Then           '第二步：任意四码相加和在取值范围内
    
34.                                     p = p + 1
    
35.                                     brr(p, 1) = arr(1, i)
    
36.                                     brr(p, 2) = arr(1, j)
    
37.                                     brr(p, 3) = arr(1, k)
    
38.                                     brr(p, 4) = arr(1, n)
    
39.                                     brr(p, 5) = arr(1, m)
    
40.                                     brr(p, 7) = "左边最后一行六码中有" & ke & "个，任意四码和值最小为" & smin & "，最大为" & smax
    
41.                                 End If
    
42.                             Next
    
43.                         End If
    
44.                     Next
    
45.                 End If
    
46.     Next: Next: Next
    
47.     If p > 0 Then [J6].Resize(p, 7) = brr
    
48. End Sub
    

复制代码

华华英雄

grf1973 发表于 2015-8-20 14:18
上午代码有点小问题，修改如下：

改为63-88，为啥不显示06 16 17 24 31这一住呢？是哪里错了？

grf1973

06+16+17+24+31=94>88