1
我試圖做一個VBA代碼來將n集的k元素子集排列成某個序列。換句話說，我試圖列出所有k-permutations of n成員集。例如，讓我們嘗試列出2-permutations of set {A,B,C}，其中每個字符都位於Range("A1:C1")的單元格中。這裏是所有排列：VBA Excel中的部分排列生成器的陣列版本
{A,B} {A,C} {B,A} {B,C} {C,A} {C,B}
下面的代碼來實現上述任務，工作正常，如果有一個在每個數據輸入的字符沒有重複：
Sub Permutation()
Dim Data_Input As Variant, Permutation_Output As Variant
Dim Output_Row As Long, Last_Column As Long
Rows("2:" & Rows.Count).Clear
Last_Column = Cells(1, Columns.Count).End(xlToLeft).Column
Data_Input = Application.Transpose(Application.Transpose(Range("A1", Cells(1, Last_Column))))
k = InputBox("Input the value of k for P(" _
& UBound(Data_Input) & " , k) where k is an integer between 2 and " _
& UBound(Data_Input) & " inclusive.", "Permutation", 1)
If k >= 2 And k <= UBound(Data_Input) Then
Output_Row = 2
ReDim Permutation_Output(1 To k)
Call Permutation_Generator(Data_Input, Permutation_Output, Output_Row, 1)
Else
MsgBox "The input [" & k & "] is invalid. The input must be an integer between 2 and " _
& UBound(Data_Input) & " inclusive."
End If
End Sub
Function Permutation_Generator(Data_Input As Variant, Permutation_Output As Variant, _
Output_Row As Long, Output_Index As Integer)
Dim i As Long, j As Long, P As Boolean
For i = 1 To UBound(Data_Input)
P = True
For j = 1 To Output_Index - 1
If Permutation_Output(j) = Data_Input(i) Then
P = False
Exit For
End If
Next j
If P Then
Permutation_Output(Output_Index) = Data_Input(i)
If Output_Index = k Then
Output_Row = Output_Row + 1
Range("A" & Output_Row).Resize(, k) = Permutation_Output
Else
Call Permutation_Generator(Data_Input, Permutation_Output, Output_Row, Output_Index + 1)
End If
End If
Next i
End Function
雖然上面的代碼中並沒有完美地工作可以處理重複數據，但我試圖通過將輸入數據放入數組並找到所有k-排列來提高其性能。以下是陣列版本中的代碼：
Option Explicit
Public k As Variant, Permutation_Table As Variant
Sub Permutation()
Dim Data_Input, Permutation_Output
Dim Output_Row As Long, Last_Column As Long
Rows("2:" & Rows.Count).Clear
Last_Column = Cells(1, Columns.Count).End(xlToLeft).Column
Data_Input = Application.Transpose(Application.Transpose(Range("A1", Cells(1, Last_Column))))
k = InputBox("Input the value of k for P(" _
& UBound(Data_Input) & " , k) where k is an integer between 2 and " _
& UBound(Data_Input) & " inclusive.", "Permutation", 1)
ReDim Permutation_Table(1 To Output_Row - 2, 1 To k)
If k >= 2 And k <= UBound(Data_Input) Then
Output_Row = 2
ReDim Permutation_Output(1 To k)
Call Permutation_Generator(Data_Input, Permutation_Output, Output_Row, 1)
Else
MsgBox "The input [" & k & "] is invalid. The input must be an integer between 2 and " _
& UBound(Data_Input) & " inclusive."
End If
Range("A3", Cells(Output_Row - 2, k)) = Permutation_Table
End Sub
Function Permutation_Generator(Data_Input As Variant, Permutation_Output As Variant, _
Output_Row As Long, Output_Index As Integer)
Dim i As Long, j As Long, n As Long, P As Boolean
For i = 1 To UBound(Data_Input)
P = True
For j = 1 To Output_Index - 1
If Permutation_Output(j) = Data_Input(i) Then
P = False
Exit For
End If
Next j
If P Then
Permutation_Output(Output_Index) = Data_Input(i)
If Output_Index = k Then
Output_Row = Output_Row + 1
For n = 1 To k
Permutation_Table(Output_Row, n) = Permutation_Output(n)
Next n
Else
Call Permutation_Generator(Data_Input, Permutation_Output, Output_Row, Output_Index + 1)
End If
End If
Next i
End Function
不幸的是，我在嘗試修復它時遇到了一些錯誤。我遇到的最後一個錯誤是運行時錯誤'7'。我希望這裏的某個人能夠幫助我解決這個問題，並且爲了製作一個好的部分字謎生成器，它可以幫助我更好地完成它，也就是說，如果有重複的字符，它必須能夠工作。例如，我們測試以列出名稱中的所有字符：ANA。 The output應該是ANA,AAN和NAA，但我的代碼什麼也沒有返回。對於2-permutations of my name應該AN，AA，並NA但我的代碼返回AN，NA，AN，並NA。 如果有人在這裏可以幫助我，我會永遠感激。