Código VBA: Liste todas as permutações possíveis no exce
By Angeliton v sredo, 29. decembra 2021
Objavljeno v Excel
odgovori 5
všeč mi je 0
Ogledov 7.8K
Glasov 0
Este Código VBA: Navedi vse todas kot permutações possíveis no Excel, preciso de uma modificão nele na forma de entrada, que está em 'MsgBox' e eu todas que seja em uma seleção de 1 coluna, daleedaetro seleção de XNUMX coluna, daledaetro seleção possivel fazer a modificação no código.
Reci 'MsgBox "Preveč permutacij!", vbInformation, "Kutools for Excel"' Que é somente digitável e não por seleção
Entra 'seleção de 1 coluna/linhas.
primer
linhas selectionadas 12345678 permutar 5 das 8 continuando como esta no codigo.
prihaja 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
Živjo Angeliton,

Videl sem tvojo kodo, a te ne razumem čisto. Ali govoriš angleško?

Amanda
Amanda Lee
·
Pred 2 leti
·
0 Likes
·
0 Glasovi
·
0 Komentarji
·
Ta koda VBA: navedite vse možne permutacije v Excelu, potrebujem spremembo v njej v obliki vnosa, ki je v 'MsgBox' in potrebujem, da je v izboru 1 stolpca in količino vrstice znotraj izbranega vrstice in je možno narediti spremembo v kodi.
odgovori odgovor
Zapusti 'MsgBox', "Preveč permutacij!", vbInformation, "Kutools za Excel"' Kar je samo digitalizirano in ne z izbiro
Vnesite '1 izbiro stolpca/vrstic.
Primer
vrstice izbranega stolpca 12345678 5 od 8, ki se nadaljujejo tako v kodi.
se začne 12345
konča z 87654. vnos podatkov opazovanja z izbiro v stolpcu
Angeliton
·
Pred 2 leti
·
0 Likes
·
0 Glasovi
·
0 Komentarji
·
Živjo Angeliton,

Tako mi je žal, da te nisem mogel popolnoma razumeti... Upam, da lahko reorganiziraš besedo.

Hvala vnaprej.
Amanda
Amanda Lee
·
Pred 2 leti
·
0 Likes
·
0 Glasovi
·
0 Komentarji
·
Živjo Amanda Lee, ta koda ima vhodne podatke za izmenjavo / možne kombinacije v MsgBox "Preveč permutacij!", vbInformation, "Kutools za Excel"
Potrebujem zamenjavo vhodnih podatkov/možne kombinacije pri izbiri stolpcev.
Primer
stolpec 1
1 vrstica = bela
2 vrstica = črna
3 vrstica = modra
4 vrstica = rumena
5 vrstica = zelena
Te vrstice se bodo zamenjale v vseh možnih kombinacijah, koda to že počne, tako da ne morem izbrati permutacijskih vrstic, ker je vhod MsgBox, ki je vtipkan in ni izbran.
celotna koda je tukaj: https://www.extendoffice.com/documents/excel/3657-excel-generate-all-permutations.html
,
Angeliton
·
Pred 2 leti
·
0 Likes
·
0 Glasovi
·
0 Komentarji
·
Živjo Angeliton,

Oprosti za pozen odgovor.

Poskusite s spodnjo kodo: (Upoštevajte, da koda ne obdeluje niza z več kot 8 znaki. Če želite povečati število, lahko spremenite številko 8 od "Če Len(xStr) >= 8 Potem" v večja kot je številka, počasnejši bi bil 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


Upam, da to dela za vas.

Amanda
Amanda Lee
·
Pred 2 leti
·
0 Likes
·
0 Glasovi
·
0 Komentarji
·
Ogled celotne objave