|
- Sub 五码()
- x = InputBox("请输入你需要的五码和值范围", "和值输入", "63-72")
- x1 = Split(x, "-")(0): x2 = Split(x, "-")(1)
- If Val(x1) < 63 Or Val(x2) > 72 Then MsgBox "请在指定范围内输入": Exit Sub
- c = [IV1].End(xlToLeft).Column
- arr = Range([J1], Cells(1, c))
- v = UBound(arr, 2)
- ReDim brr(1 To 30000, 1 To 7)
-
- crr = Cells([a65536].End(3).Row, 1).Resize(1, 6) '左边最下面一行(用于比较产生五码必须是其中1-2个)
- Set d = CreateObject("scripting.dictionary")
- For i = 1 To UBound(crr, 2)
- d(crr(1, i)) = ""
- Next
-
- [J6:AI30000].ClearContents
- For i = 1 To v - 4 '第一步:五重循环取五码(同时判断符合条件数是否为1-2个)
- If d.exists(arr(1, i)) Then kk = kk + 1 '如果是左边最下面一行中的数,kk+1
- For j = i + 1 To v - 3
- If d.exists(arr(1, j)) Then kk = kk + 1 '如果是左边最下面一行中的数,kk+1
- For k = j + 1 To v - 2
- If d.exists(arr(1, k)) Then kk = kk + 1 '如果是左边最下面一行中的数,kk+1
- If kk > 2 Then kk = 0: Exit For '符合条件超过2个,退出循环
- For n = k + 1 To v - 1
- If d.exists(arr(1, n)) Then kk = kk + 1 '如果是左边最下面一行中的数,kk+1
- If kk > 2 Then kk = 0: Exit For '符合条件超过2个,退出循环
- For m = n + 1 To v
- If d.exists(arr(1, k)) Then kk = kk + 1 '如果是左边最下面一行中的数,kk+1
- If kk > 2 Or kk = 0 Then kk = 0: Exit For '符合条件超过2个或1个没有,退出循环
- smin = arr(1, i) + arr(1, j) + arr(1, k) + arr(1, n) '前4码相加,最小值
- smax = arr(1, j) + arr(1, k) + arr(1, n) + arr(1, m) '后4码相加,最大值
- If smin >= Val(x1) And smax <= Val(x2) Then '第二步:任意四码相加和在取值范围内
- p = p + 1
- brr(p, 1) = arr(1, i)
- brr(p, 2) = arr(1, j)
- brr(p, 3) = arr(1, k)
- brr(p, 4) = arr(1, n)
- brr(p, 5) = arr(1, m)
- brr(p, 7) = "左边最后一行六码中有" & kk & "个,任意四码和值最小为" & smin & ",最大为" & smax
- End If
- Next: Next: Next: Next: Next
- If p > 0 Then [J6].Resize(p, 7) = brr
- End Sub
复制代码 |
|