|
- Sub ttt()
- arr = Range("b1:b" & [b65536].End(3).Row)
- ReDim brr(1 To UBound(arr), 1 To 12)
- Dim x(1 To 120)
- tj = [c1]
- For i = 1 To 4 ' 条件的全排列(共24种)
- For j = 1 To 4
- For k = 1 To 4
- For L = 1 To 4
- If (i - j) * (i - k) * (i - L) * (j - k) * (j - L) * (k - L) <> 0 Then
- s = s + 1
- x(s) = Mid(tj, i, 1) & Mid(tj, j, 1) & Mid(tj, k, 1) & Mid(tj, L, 1)
- End If
- Next: Next: Next: Next
- For i = 1 To UBound(arr)
- arr(i, 1) = Format(arr(i, 1), "00000")
- Next
- For i = 1 To UBound(arr)
- xstr = arr(i, 1)
- For p = 1 To s
- If InStr(xstr, x(p)) > 0 Then Exit For
- Next
- If p < s + 1 Then
- n = n + 1
- brr(n, 2) = xstr
- If i > 1 Then brr(n, 1) = arr(i - 1, 1)
- For k = 1 To 10
- If i + k <= UBound(arr) Then brr(n, 2 + k) = arr(i + k, 1)
- Next
- End If
- Next
- [d3:o1000] = ""
- If n > 0 Then [d3].Resize(n, 12) = brr
- End Sub
复制代码 |
评分
-
查看全部评分
|