Código VBA: lijst alle mogelijke opties is geen uitzondering
By Angeliton op woensdag 29 december 2021
Geplaatst in Excel
Antwoorden 5
sympathieën 0
keer bekeken 7.9K
Stemmen 0
Este Código VBA: Geef een lijst weer van alle mogelijke opties voor Excel, nauwkeurige wijziging van het formaat van de entrada, waardoor 'MsgBox' en eu precies kunnen worden gekozen voor een selectie van 1 kolom, een hoeveelheid van de geselecteerde opties, en de mogelijkheid om een ​​wijziging aan te brengen geen code.
Sai 'MsgBox "Too many permutations!", vbInformation, "Kutools for Excel"' Er zijn enkele cijfers en geen selectie beschikbaar
Kies een selectie van 1 coluna/linhas.
voorbeeld
Er is een selectie van 12345678 die 5 van 8 keer kan doorgaan als er geen code is.
comeca 12345
eindig met 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
Hallo Angeliton,

Ik zag je code, maar ik begrijp je niet helemaal. Spreek je Engels?

Amanda
Amanda Lee
·
2 jaar geleden
·
0 Likes
·
0 Stemmen
·
0 reacties
·
Deze VBA-code: maak een lijst van alle mogelijke permutaties in Excel, ik heb een wijziging nodig in de vorm van invoer, die zich in 'MsgBox' bevindt en ik heb het nodig om in een selectie van 1 kolom te staan, en het aantal rijen binnen de geselecteerde regels, en mogelijk om de wijziging in de code aan te brengen.
antwoord antwoord
Sluit 'MsgBox', "Te veel permutaties!", vbInformation, "Kutools for Excel"' af. Deze wordt alleen gedigitaliseerd en niet door selectie
Voer '1 kolom/rij selectie in.
voorbeeld
rijen van een geselecteerde kolom 12345678 5 van de 8 gaan zo door in code.
begint 12345
eindigt op 87654. invoer waarnemingsgegevens d.m.v. selectie in de kolom
Angeliton
·
2 jaar geleden
·
0 Likes
·
0 Stemmen
·
0 reacties
·
Hallo Angeliton,

Het spijt me zo dat ik je niet helemaal kon begrijpen... Ik hoop dat je het woord kunt reorganiseren.

Dank bij voorbaat.
Amanda
Amanda Lee
·
2 jaar geleden
·
0 Likes
·
0 Stemmen
·
0 reacties
·
Hallo Amanda Lee, deze code heeft invoergegevens die moeten worden uitgewisseld / mogelijke combinaties in MsgBox "Te veel permutaties!", vbInformation, "Kutools for Excel"
Ik heb invoergegevens nodig die moeten worden verwisseld/mogelijke combinaties in kolomselectie.
voorbeeld
kolom 1
1 regel = wit
2 regels = zwart
3 Lijn = blauw
4 lijn = geel
5 lijn = groen
Deze regels wisselen in alle mogelijke combinaties, de code doet dat al, dus ik kan de permutatieregels niet selecteren, omdat de invoer een MsgBox is die is getypt en niet geselecteerd.
volledige code is hier: https://www.extendoffice.com/documents/excel/3657-excel-generate-all-permutations.html
,
Angeliton
·
2 jaar geleden
·
0 Likes
·
0 Stemmen
·
0 reacties
·
Hallo Angeliton,

Sorry voor het late antwoord.

Probeer de onderstaande code: (Merk op dat de code geen tekenreeks van meer dan 8 tekens verwerkt. Als u het getal groter wilt maken, kunt u het getal 8 van "If Len(xStr) >= 8 Then" in de code wijzigen in grotere getallen. Hoe groter het getal, hoe langzamer het programma zal zijn.)

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


Ik hoop dat dit voor je werkt.

Amanda
Amanda Lee
·
2 jaar geleden
·
0 Likes
·
0 Stemmen
·
0 reacties
·
Bekijk het volledige bericht