全新

Código VBA：将 todas 列为 permutações possíveis no exce

  Excel
安吉利顿
  安吉利顿
  周三，29 2021月
  5 回复
  8K访问
0
投票
解开
Este Código VBA: Liste todas as permutações possíveis no Excel, preciso de uma modificão nele na forma de entrada, que está em 'MsgBox' e eu preciso que seja em uma seleção de 1 coluna, ea quantidade de linha dentro das linhas selecionadas, e possivel fazer a modificação no código。
Sai 'MsgBox "Too much permutations!", vbInformation, "Kutools for Excel"' Que é somente  digitalável e não por seleção
Entra 'seleção de 1 coluna/linhas.
例子
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
0
最旧的  
Amanda Lee
Amanda Lee
2年前
·
#2419
0
投票
解开
嗨安杰利顿，

我看到了你的代码，但我不太明白你的意思。 你能说英语吗？

阿曼达
安吉利顿
安吉利顿
2年前
·
#2420
0
投票
解开
此 VBA 代码：列出 Excel 中所有可能的排列，我需要以输入的形式对其进行修改，它在“MsgBox”中，我需要它在 1 列的选择中，以及所选中的行数行，并且可以在代码中进行修改。
回复回复
退出 'MsgBox'，“排列太多！”，vbInformation，“Kutools for Excel”' 仅数字化而不是选择
输入'1 列/行选择。
例子
所选列的行 12345678 5 个中的 8 个在代码中继续这样。
开始 12345
以 87654 结尾。通过在列中选择的观察数据输入
Amanda Lee
Amanda Lee
2年前
·
#2421
0
投票
解开
嗨安杰利顿，

很抱歉我不能完全理解你……希望你能重新组织这个词。

感谢在前进。
阿曼达
安吉利顿
安吉利顿
2年前
·
#2422
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
,
Amanda Lee
Amanda Lee
2年前
·
#2423
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


希望这对你有用。

阿曼达
  • 页：
  • 1
目前还没有回复。