SubGetPermutReplaceStr() '香川全排列数组元素置换算法代码
tms = Timer
Dim AP&, i%, j&, k&, l%, n%, s$
n = [a1].End(4).Row
sj = [a1].Resize(n)
l = Len(sj(1, 1))
For i = 2 To n
If Len(sj(i, 1)) > l Then l =Len(sj(i, 1))
Next
For i = 1 To n
sj(i, 1) = String(l - Len(sj(i, 1))," ") & sj(i, 1)
Next
AP = WorksheetFunction.Fact(n)
ReDim jg(1 To AP, 1 To 1)
jg(1, 1) = sj(1, 1) ': jg(1, 2) =",1-1"
k = 1
[b11] = "前期整理耗时: " & Format(Timer - tms, "0.000s ")
tms = Timer
For i = 2 To n
For j = 1 To k
s = sj(i, 1) & jg(j, 1)
jg(j, 1) = s
For p = i - 1 To 1 Step -1
k = k + 1
s = Mid(s, l + 1) & Left(s,l)
jg(k, 1) = s
Next
Next
Next
[b11] = [b11] & "/计算耗时:" & Format(Timer - tms, "0.000s ") & AP
If AP < 65536 Then [j:k] = "":[j1].Resize(AP) = jg
Erase jg
End Sub
tms = Timer
Dim AP&, i%, j&, k&, l%, n%, s$
n = [a1].End(4).Row
sj = [a1].Resize(n)
l = Len(sj(1, 1))
For i = 2 To n
If Len(sj(i, 1)) > l Then l =Len(sj(i, 1))
Next
For i = 1 To n
sj(i, 1) = String(l - Len(sj(i, 1))," ") & sj(i, 1)
Next
AP = WorksheetFunction.Fact(n)
ReDim jg(1 To AP, 1 To 1)
jg(1, 1) = sj(1, 1) ': jg(1, 2) =",1-1"
k = 1
[b11] = "前期整理耗时: " & Format(Timer - tms, "0.000s ")
tms = Timer
For i = 2 To n
For j = 1 To k
s = sj(i, 1) & jg(j, 1)
jg(j, 1) = s
For p = i - 1 To 1 Step -1
k = k + 1
s = Mid(s, l + 1) & Left(s,l)
jg(k, 1) = s
Next
Next
Next
[b11] = [b11] & "/计算耗时:" & Format(Timer - tms, "0.000s ") & AP
If AP < 65536 Then [j:k] = "":[j1].Resize(AP) = jg
Erase jg
End Sub