nセットのk要素のサブセットを何らかのシーケンスに配置するためにVBAコードを作成しようとしています。言い換えれば、私は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-permutationsを配列で見つけることによって、そのパフォーマンスを改善しようとしています。配列バージョンのコードは次のとおりです：
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について、AA、およびNAはまだ私のコードは、、NA、、およびNAを返しでなければなりません。 ここに誰かが私を助けることができたら、私は永遠に感謝しています。