CódigoVBA：todasをpermutaçõespossíveisnoexceとしてリストします
By アンジェリトン 29年2021月XNUMX日水曜日
投稿： Excel
返信 5
いいね 0
ビュー 7.9K
投票 0
エステコード VBA: Excel なしでデータを完全にリストし、正確なデータ変更、新しい形式のエントリ、「MsgBox」の正確な操作、1 つの列の選択、可能な量の選択などを実行できます。コードを変更しないでください。
Sai 'MsgBox "Too many permutations!", vbInformation, "Kutools for Excel"' 問題をデジタル化して選択する
1 つのコルナ/リーニャを選択します。
例
linhas selecionadas 12345678 permutar 5 das 8 continuando como esta no codigo.
コメサ 12345
「ターミナルem 87654」

'Sub
GetString()

'Updateby Extendoffice

    
Dim
xStr 
As
String

    
Dim
FRow 
As
Long

    
Dim
xScreen 
As
Boolean

    
xScreen = Application.ScreenUpdating

    
Application.ScreenUpdating = 
False

    
xStr = Application.InputBox(
"Enter text to permute:"
, 
"Kutools for Excel"
, , , , , , 2)

    
If
Len(xStr) < 2 
Then
Exit
Sub

    
If
Len(xStr) >= 8 
Then

        
MsgBox 
"Too many permutations!"
, vbInformation, 
"Kutools for Excel"

        
Exit
Sub

    
Else

        
ActiveSheet.Columns(1).Clear

        
FRow = 1

        
Call
GetPermutation(
""
, xStr, FRow)

    
End
If

    
Application.ScreenUpdating = xScreen

End
Sub

Sub
GetPermutation(Str1 
As
String
, Str2 
As
String
, 
ByRef
xRow 
As
Long
)

    
Dim
i 
As
Integer
, xLen 
As
Integer

    
xLen = Len(Str2)

    
If
xLen < 2 
Then

        
Range(
"A"
& xRow) = Str1 & Str2

        
xRow = xRow + 1

    
Else

        
For
i = 1 
To
xLen

            
Call
GetPermutation(Str1 + Mid(Str2, i, 1), Left(Str2, i - 1) + Right(Str2, xLen - i), xRow)

        
Next

    
End
If

'End
Sub
こんにちは、アンジェリトンさん

コードを見ましたが、よくわかりません。 あなたは英語を話せますか？

アマンダ
アマンダリー
·
2年前
·
0が好き
·
0投票
·
0のコメント
·
この VBA コード: Excel で考えられるすべての順列をリストします。「MsgBox」にある入力の形式で変更が必要です。1 列の選択と、選択した行内の行の量が必要で、コード内で変更が可能です。
返信返信
「MsgBox」、「順列が多すぎます!」、vbInformation、「Kutools for Excel」を終了します。これは選択によってではなくデジタル化されるだけです
「1 列/行の選択」を入力してください。
例
選択した列の行 12345678 5 個のうち 8 個はコード内で次のように続きます。
12345 から始まります
87654で終わります。 観測データは欄の選択により入力します
アンジェリトン
·
2年前
·
0が好き
·
0投票
·
0のコメント
·
こんにちは、アンジェリトンさん

あなたの言うことを完全に理解できなくて申し訳ありません...言葉を再構成していただければ幸いです。

よろしくお願いします。
アマンダ
アマンダリー
·
2年前
·
0が好き
·
0投票
·
0のコメント
·
こんにちはアマンダ・リー、このコードには交換する入力データ/MsgBox の可能な組み合わせがあります「順列が多すぎます!」、vbInformation、「Kutools for Excel」
入力データを交換する必要があります/列選択で可能な組み合わせが必要です。
例
列1
1本線＝白
2本線＝黒
3 ライン = 青
4本線＝黄色
5本線＝緑
これらの行はすべての可能な組み合わせで入れ替えられますが、コードでは既にそれが行われているため、入力が入力されただけで選択されていない MsgBox であるため、置換行を選択することはできません。
完全なコードはここにあります: https://www.extendoffice.com/documents/excel/3657-excel-generate-all-permutations.html
,
アンジェリトン
·
2年前
·
0が好き
·
0投票
·
0のコメント
·
こんにちは、アンジェリトンさん

返事が遅れて申し訳ありません。

以下のコードを試してください: (このコードは 8 文字を超える文字列を処理しないことに注意してください。数値を大きくしたい場合は、コード内の「If Len(xStr) >= 8 then」の数値 8 をより大きな数値に変更できます。ただし、数値が大きくなるほど、プログラムは遅くなります。)

Sub GetString()

'Updateby Extendoffice

Dim xStr As String

Dim FRow As Long

Dim xScreen As Boolean

Dim Rg, xRg As Range

xScreen = Application.ScreenUpdating

Application.ScreenUpdating = False

Set xRg = Application.InputBox("Enter text to permute:", "Kutools for Excel", , , , , , 8)

xStr = ""

For Each Rg In xRg

xStr = xStr + Rg.Text

Next

If Len(xStr) < 2 Then Exit Sub

If Len(xStr) >= 8 Then

MsgBox "Too many permutations!", vbInformation, "Kutools for Excel"

Exit Sub

Else

ActiveSheet.Columns(1).Clear

FRow = 1

Call GetPermutation("", xStr, FRow)

End If

Application.ScreenUpdating = xScreen

End Sub

Sub GetPermutation(Str1 As String, Str2 As String, ByRef xRow As Long)

Dim i As Integer, xLen As Integer

xLen = Len(Str2)

If xLen < 2 Then

Range("A" & xRow) = Str1 & Str2

xRow = xRow + 1

Else

For i = 1 To xLen

Call GetPermutation(Str1 + Mid(Str2, i, 1), Left(Str2, i - 1) + Right(Str2, xLen - i), xRow)

Next

End If

End Sub


これがあなたのために働くことを願っています。

アマンダ
アマンダリー
·
2年前
·
0が好き
·
0投票
·
0のコメント
·
投稿全体を見る