Kód VBA: Liste todas as permutações possíveis no exce
By Angeliton ve středu 29. prosince 2021
Publikováno v vynikat
Odpovědi 5
záliby 0
Zobrazení 8K
Hlasy 0
Este Código VBA: Liste todas as permutações possíveis no Excel, preciso de modificão nele for form de entrada, que está em 'MsgBox' e eu preciso que seja em uma seleção de 1 coluna, dalechade den quant possivel fazer a modificação no código.
Sai 'MsgBox "Příliš mnoho permutací!", vbInformation, "Kutools pro Excel"' Que é somente digitável a não por seleção
Vstup pro výběr 1 sloupce/linhas.
příklad
linhas selecionadas 12345678 permutar 5 das 8 continuando como esta no codigo.
přijde 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
Ahoj Angelito,

Viděl jsem tvůj kód, ale moc ti nerozumím. Mluvíš anglicky?

Amanda
Amanda Lee
·
Před 2 let
·
0 Likes
·
0 hlasů
·
0 Komentáře
·
Tento kód VBA: Seznam všech možných permutací v Excelu, potřebuji v něm úpravu ve formě vstupu, který je v 'MsgBox' a potřebuji, aby byl ve výběru 1 sloupec a množství řádku ve vybraném řádků a je možné provést úpravy v kódu.
odpovědět odpovědět
Ukončí 'MsgBox', "Příliš mnoho permutací!", vbInformation, "Kutools pro Excel"' Který je pouze digitalizován a nikoli výběrem
Zadejte 'výběr 1 sloupce/řádků.
příklad
řádky vybraného sloupce 12345678 5 z 8 pokračují takto v kódu.
začíná 12345
končí na 87654. záznam pozorovacích dat výběrem ve sloupci
Angeliton
·
Před 2 let
·
0 Likes
·
0 hlasů
·
0 Komentáře
·
Ahoj Angelito,

Je mi líto, že jsem vám plně nerozuměl... Doufám, že to slovo dokážete reorganizovat.

Díky předem.
Amanda
Amanda Lee
·
Před 2 let
·
0 Likes
·
0 hlasů
·
0 Komentáře
·
Ahoj Amando Lee, tento kód má vstupní data k výměně / možné kombinace v MsgBox "Příliš mnoho permutací!", vbInformation, "Kutools pro Excel"
Potřebuji, aby byla vstupní data prohozena/možné kombinace ve výběru sloupců.
příklad
sloupec 1
1 řádek = bílá
2 řádek = černá
3 Linka = modrá
4 řádek = žlutá
5 řádek = zelená
Tyto řádky se prohodí ve všech možných kombinacích, kód to již dělá, takže nemohu vybrat permutační řádky, protože vstupem je MsgBox, který je napsaný a není vybrán.
celý kód je zde: https://www.extendoffice.com/documents/excel/3657-excel-generate-all-permutations.html
,
Angeliton
·
Před 2 let
·
0 Likes
·
0 hlasů
·
0 Komentáře
·
Ahoj Angelito,

Omlouváme se za pozdní odpověď.

Vyzkoušejte prosím kód níže: (Všimněte si, že kód nezpracovává řetězec delší než 8 znaků. Pokud chcete číslo zvětšit, můžete změnit číslo 8 v „If Len(xStr) >= 8 Then“ v kód na větší čísla. Čím větší je však číslo, tím pomalejší bude program.)

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


Doufám, že to funguje pro vás.

Amanda
Amanda Lee
·
Před 2 let
·
0 Likes
·
0 hlasů
·
0 Komentáře
·
Zobrazit celý příspěvek