Přejít k hlavnímu obsahu

Jak generovat nebo vypsat všechny možné permutace v aplikaci Excel?

Například mám tři znaky XYZ, teď chci vypsat všechny možné permutace založené na těchto třech znacích, abych získal šest různých výsledků takto: XYZ, XZY, YXZ, YZX, ZXY a ZYX. Jak můžete v aplikaci Excel rychle vygenerovat nebo vypsat všechny permutace na základě různého počtu znaků?

Vygenerujte nebo vypsejte všechny možné obměny na základě znaků pomocí kódu VBA

šipka modrá pravá bublina Vygenerujte nebo vypsejte všechny možné obměny na základě znaků pomocí kódu VBA

Následující kód VBA vám může pomoci se seznamem všech permutací na základě vašeho konkrétního počtu písmen, postupujte takto:

1. Podržte ALT + F11 klávesy pro otevření Microsoft Visual Basic pro aplikace okno.

2, klikněte Vložit > Modula vložte následující kód do Modul Okno.

Kód VBA: Seznam všech možných permutací v aplikaci Excel

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

3. Pak stiskněte tlačítko F5 klíč ke spuštění tohoto kódu a zobrazí se okno s výzvou, které vám připomene zadání znaků, které chcete vypsat do všech permutací, viz screenshot:

permutace seznamu dokumentů 1

4. Po zadání znaků a poté klikněte na OK Ve sloupci A aktivního listu se zobrazí všechny možné permutace. Viz screenshot:

permutace seznamu dokumentů 2

Poznámka: Pokud je zadaná délka znaků rovna nebo větší než 8 znaků, tento kód nebude fungovat, protože existuje příliš mnoho permutací.

permutace seznamu dokumentů 3

Seznamujte nebo generujte všechny možné kombinace z více sloupců

Pokud potřebujete vygenerovat všechny možné kombinace založené na datech více sloupců, možná neexistuje dobrý způsob řešení úlohy. Ale, Kutools pro Excel's Seznam všech kombinací vám pomůže rychle a snadno vypsat všechny možné kombinace. Klikněte a stáhněte si Kutools pro Excel!

seznam všech kombinací

Kutools pro Excel: s více než 300 praktickými doplňky aplikace Excel, můžete vyzkoušet bez omezení do 30 dnů. Stáhněte si a vyzkoušejte zdarma hned teď!

Nejlepší nástroje pro produktivitu v kanceláři

🤖 Kutools AI asistent: Revoluční analýza dat založená na: Inteligentní provedení   |  Generovat kód  |  Vytvořte vlastní vzorce  |  Analyzujte data a generujte grafy  |  Vyvolejte funkce Kutools...
Populární funkce: Najít, zvýraznit nebo identifikovat duplikáty   |  Odstranit prázdné řádky   |  Kombinujte sloupce nebo buňky bez ztráty dat   |   Kolo bez vzorce ...
Super vyhledávání: Více kritérií VLookup  |   VLookup s více hodnotami  |   VLookup na více listech   |   Fuzzy vyhledávání ....
Pokročilý rozevírací seznam: Rychle vytvořte rozevírací seznam   |  Závislý rozbalovací seznam   |  Vícenásobný výběr rozevíracího seznamu ....
Správce sloupců: Přidejte konkrétní počet sloupců  |  Přesunout sloupce  |  Přepnout stav viditelnosti skrytých sloupců  |  Porovnejte rozsahy a sloupce ...
Doporučené funkce: Zaměření mřížky   |  Návrhové zobrazení   |   Velký Formula Bar   |  Správce sešitů a listů   |  Knihovna zdrojů (Automatický text)   |  Výběr data   |  Zkombinujte pracovní listy   |  Šifrovat/dešifrovat buňky   |  Odesílat e-maily podle seznamu   |  Super filtr   |   Speciální filtr (filtr tučné/kurzíva/přeškrtnuté...) ...
Top 15 sad nástrojů:  12 Text Tools (doplnit text, Odebrat znaky, ...)   |   50+ Graf Typ nemovitosti (Ganttův diagram, ...)   |   40+ Praktické Vzorce (Vypočítejte věk na základě narozenin, ...)   |   19 Vložení Tools (Vložte QR kód, Vložit obrázek z cesty, ...)   |   12 Konverze Tools (Čísla na slova, Přepočet měny, ...)   |   7 Sloučit a rozdělit Tools (Pokročilé kombinování řádků, Rozdělit buňky, ...)   |   ... a více

Rozšiřte své dovednosti Excel pomocí Kutools pro Excel a zažijte efektivitu jako nikdy předtím. Kutools for Excel nabízí více než 300 pokročilých funkcí pro zvýšení produktivity a úsporu času.  Kliknutím sem získáte funkci, kterou nejvíce potřebujete...

Popis

Office Tab přináší do Office rozhraní s kartami a usnadňuje vám práci

  • Povolte úpravy a čtení na kartách ve Wordu, Excelu, PowerPointu, Publisher, Access, Visio a Project.
  • Otevřete a vytvořte více dokumentů na nových kartách ve stejném okně, nikoli v nových oknech.
  • Zvyšuje vaši produktivitu o 50%a snižuje stovky kliknutí myší každý den!
Comments (13)
No ratings yet. Be the first to rate!
Mateus
Mateus
This comment was minimized by the moderator on the site
Olá !

Como faço para gerar pelo menos 10 permutações ?
Reply
0
0
skyyang
skyyang     Mateus
This comment was minimized by the moderator on the site
Hello, Mateus,
To solve your problem, please apply the below code:(Note: if there are more than 8 characters, the code will execute slowly.)
Sub GetString()
'Updateby Extendoffice
    Dim xStr As String
    Dim FRow As Long
    Dim FC As Integer
    Dim xScreen As Boolean
    Dim xNumber As Long
    xNumber = 10 ' This is the max length of the characters you can change it to 11, 12, 13...as you need
    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) > xNumber Then
        MsgBox "Too many permutations!", vbInformation, "Kutools for Excel"
        Exit Sub
    Else
        ActiveSheet.Columns(1).Clear
        FRow = 1
        FC = 1
        Call GetPermutation("", xStr, FRow, FC)
    End If
    Application.ScreenUpdating = xScreen
End Sub
Sub GetPermutation(Str1 As String, Str2 As String, ByRef xRow As Long, ByRef xc As Integer)
    Dim i As Integer, xLen As Integer
    xLen = Len(Str2)
    If xLen < 2 Then
        If xRow > 1000000 Then
            xc = xc + 1
            xRow = 1
        End If
       ActiveSheet.Cells(xRow, xc) = 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, xc)
        Next
    End If
End Sub


Please have a try, hope it can help you!
Reply
Report
0
0
DVdm
DVdm
This comment was minimized by the moderator on the site
Hi there, if the input string contains duplicate chars, then the sub produces duplicate permutations.
This does not happen if you make the following modification the the loop:

' ==========================
For i = 1 To xLen
If Instr( Left(Str2, i - 1), Mid(Str2, i, 1) ) = 0 then
Call GetPermutation(Str1 + Mid(Str2, i, 1), Left(Str2, i - 1) + Right(Str2, xLen - i), xRow)
End if
Next
' ==========================

Creating temporary local variables for Mid(Str2, i, 1) and for Left(Str2, i - 1), and avoiding the test for i=1 makes it go faster:


' ==========================
Sub GetPermutation(Str1 As String, Str2 As String, ByRef xRow As Long)
Dim i As Integer, xLen As Integer, Str2left as String, c as String
xLen = Len(Str2)
If xLen < 2 Then
Range("A" & xRow) = Str1 & Str2
xRow = xRow + 1
Else
Call GetPermutation(Str1 + Mid(Str2, 1, 1), Right(Str2, xLen - 1), xRow)
For i = 2 To xLen
c = Mid(Str2, i, 1)
Str2left = Left(Str2, i - 1)
If Instr( Str2left, c ) = 0 then
Call GetPermutation(Str1 + c, Str2left + Right(Str2, xLen - i), xRow)
End If
Next
End If
End Sub
' ==========================

Cheers,
DVdm
Reply
Report
0
0
lyto
lyto
This comment was minimized by the moderator on the site
who can send me a list of 10 diferent items permutatted by 2 outcomes. this code doe

snt work on this
Reply
0
0
ilhan
ilhan
This comment was minimized by the moderator on the site
peki bunu listeleyecek bir program uygulama yok mu?basit sıradan bir hesaplamadan daha fazlasına ihtiyacı olan ne yapacak?
Reply
0
0
MC
MC
This comment was minimized by the moderator on the site
this code will not work because there are two many permutations


should be:

this code will not work because there are too many permutations


HTH
Reply
0
0
skyyang
skyyang     MC
This comment was minimized by the moderator on the site
Hello, MC,
Thank you for your warm reminder, it is my mistake. I have corrected it.
Thanks a lot!
Reply
Report
0
0
Paul
Paul
This comment was minimized by the moderator on the site
Hello everyone. I need help on this. I have two alphabets to be permutated in 20 rows. But am not getting it right. Anyone who could help me out should send the permutation to my email. .


1.a b b a
2.a a b b
3.a a b b
4.a a b b
5.a a b b
6.a a b b
7.a a b b
8.a a b b
9.a a b b
10.a a b b
11.a a b b
12.a a b b
13.a a b b
14.a a b b
15.a a b b
16.a a b b
17.a a b b
18.a a b b
19.a a b b
20.a a b b
Reply
0
0
Wule
Wule
This comment was minimized by the moderator on the site
How many sequences of 3things can be formed from 7 different things replacement and order is important?
Reply
0
0
Guest
Guest     Wule
This comment was minimized by the moderator on the site
3 to the power of 7: 2187
Reply
0
0
declankeogh01@gmail.com
This comment was minimized by the moderator on the site
@Supraja...

in the first sub clear all cells... not just the first row
--Cells.Clear

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
'move to the next column when you get to 100
Cells(((xRow - 1) Mod 100) + 1, 1 + Int(xRow / 100)) = 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
Reply
Report
0
0
Supraja
Supraja
This comment was minimized by the moderator on the site
Hello,

Im trying to get a permutation for 82 characters, the code provided works, but, since the columns are only 1048576, I want to move the next output in B,C,D..... Can any of you help me on this regard
Reply
0
0
Terence
Terence
This comment was minimized by the moderator on the site
Hello, Im doing a small project using permutation and combination rules. I need your support on this please. Scenario: I have 13 digit alpha numeric data (00SHGO8BJIDG0) I want a coding to interchange S to 5, I to 1 and O to 0 and vise versa. The project is that if I have the correct 13 digit data I will receive a 3 digit pass code. (eg) 00SHG08BJ1DG0 - 500 is the pass code but because of wrong typo that is instead of 1 it was I and 0 it was O there is a wrong info. can you please help me.
Reply
0
0
There are no comments posted here yet
Please leave your comments in English
Guest
Posting as Guest
×
Rate this post:
Reset
0   Characters
Suggested Locations