Código VBA：將 todas 列為 permutações possíveis no exce
By 安吉利頓 29 年 2021 月 XNUMX 日，星期三
張貼在 Excel
回复 5
讚 0
觀看 8K
投票 0
Este Código VBA：列出所有沒有 Excel 的選項，精確修改格式，在「MsgBox」中精確設定 1 列的選項，對所選行的數量進行量化，可能無法修改程式碼。
Sai 'MsgBox "Too much permutations!", vbInformation, "Kutools for Excel"' Que é somente  digitalável e não por seleção
進入第 1 欄/林哈斯選擇。
例子
linhas selecionadas 12345678 permutar 5 das 8 Continando 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 個評論
·
嗨，Amanda Lee，此程式碼在 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 個評論
·
查看全文