我是 Excel VBA 的新手,正在通过修改/更改现有代码进行学习。我尝试了一些代码,这些代码接受一个字符串并给出下一个排列。我的数据在单元格 A1 中,由逗号分隔的数字组成。它将分隔符视为数据的一部分。如果我尝试排列两位数(10 等),它会将它们视为 1 和 0。
Function nextPerm(s As String)
' inspired by http://stackoverflow.com/questions/352203/generating-permutations-lazily
' this produces the "next" permutation
' it allows one to step through all possible iterations without having to have them
' all in memory at the same time
Dim L As Integer, ii As Integer, jj As Integer
Dim c() As Byte, temp As Byte
L = Len(s)
If StrComp(s, "**done**") = 0 Or StrComp(s, "") = 0 Then
nextPerm = ""
Exit Function
End If
' convert to byte array... more compact to manipulate
ReDim c(1 To L)
For ii = 1 To L
c(ii) = Asc(Mid(s, ii, 1))
Next ii
' find the largest "tail":
For ii = L - 1 To 1 Step -1
If c(ii) < c(ii + 1) Then Exit For
Next ii
' if we complete the loop without break, ii will be zero
If ii = 0 Then
nextPerm = "**done**"
Exit Function
End If
' find the smallest value in the tail that is larger than c(ii)
' take advantage of the fact that tail is sorted in reverse order
For jj = L To ii + 1 Step -1
If c(jj) > c(ii) Then
' swap elements
temp = c(jj)
c(jj) = c(ii)
c(ii) = temp
Exit For
End If
Next jj
' now reverse the characters from ii+1 to the end:
nextPerm = ""
For jj = 1 To ii
nextPerm = nextPerm & Chr(c(jj))
Next jj
For jj = L To ii + 1 Step -1
nextPerm = nextPerm & Chr(c(jj))
Next jj
End Function
我需要做哪些改变才能使其工作?
答案1
这是逗号分隔列表的版本:
Function nextPerm2(s As String)
' inspired by http://stackoverflow.com/questions/352203/generating-permutations-lazily
' this produces the "next" permutation
' it allows one to step through all possible iterations without having to have them
' all in memory at the same time
Dim L As Integer, ii As Integer, jj As Integer
Dim c() As Variant, temp As Variant
L = Len(s)
If StrComp(s, "**done**") = 0 Or StrComp(s, "") = 0 Then
nextPerm2 = ""
Exit Function
End If
' convert to byte array... more compact to manipulate
arr = Split(s, ",")
ReDim c(1 To UBound(arr) + 1)
For ii = 1 To UBound(arr) + 1
c(ii) = arr(ii - 1)
Next ii
L = UBound(arr) + 1
' find the largest "tail":
For ii = L - 1 To 1 Step -1
If c(ii) < c(ii + 1) Then Exit For
Next ii
' if we complete the loop without break, ii will be zero
If ii = 0 Then
nextPerm2 = "**done**"
Exit Function
End If
' find the smallest value in the tail that is larger than c(ii)
' take advantage of the fact that tail is sorted in reverse order
For jj = L To ii + 1 Step -1
If c(jj) > c(ii) Then
' swap elements
temp = c(jj)
c(jj) = c(ii)
c(ii) = temp
Exit For
End If
Next jj
' now reverse the characters from ii+1 to the end:
nextPerm2 = ""
For jj = 1 To ii
nextPerm2 = nextPerm2 & c(jj) & ","
Next jj
For jj = L To ii + 1 Step -1
nextPerm2 = nextPerm2 & c(jj) & ","
Next jj
If Right(nextPerm2, 1) = "," Then nextPerm2 = Left(nextPerm2, Len(nextPerm2) - 1)
End Function
解析用途Split()
并且还有其他变化。
未经过全面测试!
答案2
我没有改变初始帖子中的算法:
- C++:惰性生成排列(链接)
- VBA:在 VBA 中排列数组来计算 Shapley-Shubik 幂指数(链接)
- 或初始文章:C++ 算法:next_permutation()(外部链接)
但我确实将 VBA 代码修改为更具描述性的变量名,并允许在初始字符串中使用分隔符作为参数:
Option Explicit
Public Sub ShowPerm()
With Sheet1
.Range("B1") = nextPerm2(.Range("A1"))
.Range("B2") = nextPerm2(.Range("A2"), " ")
.Range("B3") = nextPerm2(.Range("A3"), " ")
.Range("B4") = nextPerm2(.Range("A4"))
End With
'if A1 = "3,2,5,4,1" Then B1 = "3,4,1,2,5"
'if A2 = "3 222 5 4 1" Then B2 = "3 4 1 222 5"
'if A3 = "1" Then B3 = "**done**"
'if A4 = "2" Then B4 = "**done**"
End Sub
Public Function nextPerm2(ByVal strIni As String, _
Optional ByVal delim As String = ",") As String
'inspired by http://stackoverflow.com/questions/352203/generating-permutations-lazily
'this produces the "next" permutation it allows one to step through all possible
'iterations without having to have them all in memory at the same time
Dim arr As Variant, arrSz As Long, i As Long, j As Long, tmp As Byte
If strIni = "**done**" Or Len(strIni) = 0 Then Exit Function
arr = Split(strIni, delim) 'convert to array
arrSz = UBound(arr)
For i = 0 To arrSz
arr(i) = Trim(arr(i)) 'clean-up white-spaces from each item
Next i
For i = arrSz - 1 To 0 Step -1 'find the largest "tail"
If arr(i) < arr(i + 1) Then Exit For
Next i
If i = 0 Or i = -1 Then 'if loop complete, i is 0; if i = -1, arrSz = 0
nextPerm2 = "**done**"
Exit Function
End If
'find the smallest value in the tail that is larger than arr(i)
'take advantage of the fact that tail is sorted in reverse order
For j = arrSz To i + 1 Step -1
If arr(j) > arr(i) Then 'swap elements
tmp = arr(j)
arr(j) = arr(i)
arr(i) = tmp
Exit For
End If
Next j
'now reverse the characters from i + 1 to the end
nextPerm2 = vbNullString
For j = 0 To i
nextPerm2 = nextPerm2 & arr(j) & delim
Next j
For j = arrSz To i + 1 Step -1
nextPerm2 = nextPerm2 & arr(j) & delim
Next j
nextPerm2 = Left(nextPerm2, Len(nextPerm2) - 1) 'remove last delim
End Function