DefLng A-N Sub macro1() Application.ScreenUpdating = False [l:q] = "" Dim s, x(5), arr(1 To 65536, 1 To 6), befit As Boolean s = [a1].CurrentRegion.Value For A = 2 To 7 x(0) = s(1, A) For b = 2 To 7 x(1) = s(2, b) For c = 2 To 7 x(2) = s(3, c) For d = 2 To 7 x(3) = s(4, d) For e = 2 To 7 x(4) = s(5, e) For f = 2 To 7 x(5) = s(6, f) befit = True For i = 0 To 4 For j = i + 1 To 5 If x(i) = x(j) Or Len(x(i)) * Len(x(j)) = 0 Then befit = False: Exit For: Exit For Next Next If befit = True Then n = n + 1 For i = 1 To 6 arr(n, i) = x(i - 1) Next End If Next f, e, d, c, b, A [l1].Resize(n, 6) = arr Application.ScreenUpdating = True MsgBox "共找到" & n & "种组合,成就五百万梦想!!!" End Sub |