[已解决]按附件要求结果

meet10010 · 发表于 2015-1-23 22:56

本帖最后由 meet10010 于 2015-1-24 10:38 编辑

按附件要求结果

最佳答案

dsmch

2015-1-24 04:20

Sub Macro1()
Dim arr, brr(1 To 65000, 1 To 1), w(9)
Dim a%, b%, c%, d%, e%, s&, n%
arr = [a22:iv23]
n = 50 'UBound(arr, 2)
For a = 2 To n - 5
For b = a + 1 To n - 3
For c = b + 1 To n - 2
For d = c + 1 To n - 1
For e = d + 1 To n
w(arr(1, a)) = arr(1, a)
w(arr(1, b)) = arr(1, b)
w(arr(1, c)) = arr(1, c)
w(arr(1, d)) = arr(1, d)
w(arr(1, e)) = arr(1, e)
w(arr(2, a)) = arr(2, a)
w(arr(2, b)) = arr(2, b)
w(arr(2, c)) = arr(2, c)
w(arr(2, d)) = arr(2, d)
w(arr(2, e)) = arr(2, e)
If Len(Join(w, "")) = 10 Then s = s + 1: brr(s, 1) = a & "," & b & "," & c & "," & d & "," & e
Erase w
If s > 60000 Then GoTo line100
Next
Next
Next
Next
Next
line100:
'结果代表符合数据所在的列
Range("a26").Resize(s) = brr
End Sub

复制代码

芐雨 · 发表于 2015-1-23 23:02

数字只是0-9？

dsmch · 发表于 2015-1-24 04:20

Sub Macro1()
Dim arr, brr(1 To 65000, 1 To 1), w(9)
Dim a%, b%, c%, d%, e%, s&, n%
arr = [a22:iv23]
n = 50 'UBound(arr, 2)
For a = 2 To n - 5
For b = a + 1 To n - 3
For c = b + 1 To n - 2
For d = c + 1 To n - 1
For e = d + 1 To n
w(arr(1, a)) = arr(1, a)
w(arr(1, b)) = arr(1, b)
w(arr(1, c)) = arr(1, c)
w(arr(1, d)) = arr(1, d)
w(arr(1, e)) = arr(1, e)
w(arr(2, a)) = arr(2, a)
w(arr(2, b)) = arr(2, b)
w(arr(2, c)) = arr(2, c)
w(arr(2, d)) = arr(2, d)
w(arr(2, e)) = arr(2, e)
If Len(Join(w, "")) = 10 Then s = s + 1: brr(s, 1) = a & "," & b & "," & c & "," & d & "," & e
Erase w
If s > 60000 Then GoTo line100
Next
Next
Next
Next
Next
line100:
'结果代表符合数据所在的列
Range("a26").Resize(s) = brr
End Sub

复制代码

		自动登录	找回密码
密码			注册