Código VBA: Liste todas as permutações possíveis no exce
By Angeliton onsdagen den 29 december 2021
Inlagd i excel
svar 5
Gillar 0
Visningar 8K
Röster 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, ea quantidade de linha possivel fazer a modificação no código.
Sai 'MsgBox "För många permutationer!", vbInformation, "Kutools för Excel"' Que é somente digitável e não por seleção
Entra 'seleção de 1 coluna/linhas.
exempel
linhas selecionadas 12345678 permutar 5 das 8 continuando como esta no codigo.
começa 12345
'termina 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
Hej Angeliton,

Jag såg din kod, men jag förstår dig inte riktigt. Kan du prata engelska?

Amanda
Amanda Lee
·
2 år sedan
·
0 Likes
·
0 Röster
·
0 Kommentarer
·
Denna VBA-kod: Lista alla möjliga permutationer i Excel, jag behöver en modifiering i den i form av inmatning, som finns i 'MsgBox' och jag behöver att den ska vara i ett urval av 1 kolumn, och mängden rad inom den valda rader och möjligt att göra ändringen i koden.
svara svar
Avslutar 'MsgBox', "Too many permutations!", vbInformation, "Kutools for Excel"' som endast digitaliseras och inte genom val
Ange '1 kolumn/rader val.
exempel
rader i en vald kolumn 12345678 5 av de 8 fortsätter så här i koden.
börjar 12345
slutar på 87654. observationsdatainmatning genom val i kolumnen
Angeliton
·
2 år sedan
·
0 Likes
·
0 Röster
·
0 Kommentarer
·
Hej Angeliton,

Så ledsen att jag inte helt kunde förstå dig... Hoppas du kan omorganisera ordet.

Tack på förhand.
Amanda
Amanda Lee
·
2 år sedan
·
0 Likes
·
0 Röster
·
0 Kommentarer
·
Hej Amanda Lee, den här koden har indata som ska utbytas / möjliga kombinationer i MsgBox "Too many permutations!", vbInformation, "Kutools for Excel"
Jag behöver indata som ska bytas/möjliga kombinationer i kolumnval.
exempel
kolumn 1
1 rad = vit
2 rad = svart
3 Linje = blå
4 rad = gul
5 rad = grön
Dessa rader kommer att byta i alla möjliga kombinationer, koden gör det redan så jag kan inte välja permutationsraderna, eftersom ingången är en MsgBox som är inskriven och inte vald.
hela koden finns här: https://www.extendoffice.com/documents/excel/3657-excel-generate-all-permutations.html
,
Angeliton
·
2 år sedan
·
0 Likes
·
0 Röster
·
0 Kommentarer
·
Hej Angeliton,

Förlåt för det sena svaret.

Prova koden nedan: (Observera att koden inte bearbetar en sträng med över 8 tecken. Om du vill göra siffran större kan du ändra siffran 8 för "If Len(xStr) >= 8 Then" i kod till större siffror. Ju större numret är, desto långsammare blir programmet.)

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


Hoppas detta fungerar för dig.

Amanda
Amanda Lee
·
2 år sedan
·
0 Likes
·
0 Röster
·
0 Kommentarer
·
Visa hela inlägget