Note: The other languages of the website are Google-translated. Back to English

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ší kancelářské nástroje produktivity

Kutools pro Excel řeší většinu vašich problémů a zvyšuje vaši produktivitu o 80%

  • Opakované použití: Rychle vložte složité vzorce, grafy a cokoli, co jste dříve používali; Šifrovat buňky s heslem; Vytvořte seznam adresátů a posílat e-maily ...
  • Super Formula Bar (snadno upravit více řádků textu a vzorce); Rozložení pro čtení (snadno číst a upravovat velké množství buněk); Vložit do filtrovaného rozsahu...
  • Sloučit buňky / řádky / sloupce bez ztráty dat; Rozdělit obsah buněk; Zkombinujte duplicitní řádky / sloupce... Zabraňte duplicitním buňkám; Porovnat rozsahy...
  • Vyberte možnost Duplikovat nebo Jedinečný Řádky; Vyberte prázdné řádky (všechny buňky jsou prázdné); Super hledání a fuzzy hledání v mnoha sešitech; Náhodný výběr ...
  • Přesná kopie Více buněk beze změny odkazu na vzorec; Automaticky vytvářet reference do více listů; Vložte odrážky, Zaškrtávací políčka a další ...
  • Extrahujte text, Přidat text, Odebrat podle pozice, Odebrat mezeru; Vytváření a tisk mezisoučtů stránkování; Převod mezi obsahem buněk a komentáři...
  • Super filtr (uložit a použít schémata filtrů na jiné listy); Rozšířené řazení podle měsíce / týdne / dne, frekvence a dalších; Speciální filtr tučnou kurzívou ...
  • Kombinujte sešity a pracovní listy; Sloučit tabulky na základě klíčových sloupců; Rozdělte data do více listů; Dávkový převod xls, xlsx a PDF...
  • Více než 300 výkonných funkcí. Podporuje Office / Excel 2007-2019 a 365. Podporuje všechny jazyky. Snadné nasazení ve vašem podniku nebo organizaci. Kompletní funkce 30denní bezplatná zkušební verze. 60denní záruka vrácení peněz.
karta kte 201905

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 omezuje stovky kliknutí myší každý den!
officetab dno
Komentáře (13)
Zatím žádné hodnocení. Buďte první, kdo ohodnotí!
Tento komentář byl moderátorem webu minimalizován
Dobrý den, dělám malý projekt pomocí permutačních a kombinačních pravidel. Prosím o vaši podporu. Scénář: Mám 13místná alfanumerická data (00SHGO8BJIDG0) Chci kódování pro výměnu S na 5, I na 1 a O na 0 a naopak. Projekt spočívá v tom, že pokud budu mít správná 13místná data, obdržím 3místný přístupový kód. (např.) 00SHG08BJ1DG0 - 500 je přístupový kód, ale kvůli špatnému překlepu, který je místo 1 to bylo I a 0 to bylo O, jsou zde špatné informace. můžete mi prosím pomoci.
Tento komentář byl moderátorem webu minimalizován
Ahoj,

Snažím se získat permutaci pro 82 znaků, poskytnutý kód funguje, ale protože sloupce jsou pouze 1048576, chci přesunout další výstup do B, C, D..... Může mi někdo z vás pomoci v tomto považovat
Tento komentář byl moderátorem webu minimalizován
@Supraja...

v první části vymazat všechny buňky... nejen první řádek
--Cells. Clear

Sub GetPermutation (Str1 jako řetězec, Str2 jako řetězec, ByRef xRow jako dlouhý)
Dim i As Integer, xLen As Integer
xLen = Len(Str2)
Pokud xLen < 2 Pak
'přesuňte se na další sloupec, když se dostanete na 100
Cells(((xRow - 1) Mod 100) + 1, 1 + Int(xRow / 100)) = Str1 & Str2
xRow = xRow + 1
Jiný
Pro i = 1 To xLen
Volání GetPermutation(Str1 + Mid(Str2, i, 1), Left(Str2, i - 1) + Right (Str2, xLen - i), xRow)
další
End If
End Sub
Tento komentář byl moderátorem webu minimalizován
Kolik sekvencí 3 věcí lze vytvořit ze 7 různých věcí, výměna a pořadí je důležité?
Tento komentář byl moderátorem webu minimalizován
3 k síle 7:2187
Tento komentář byl moderátorem webu minimalizován
Ahoj všichni. Potřebuji s tím pomoct. Mám dvě abecedy, které mají být permutovány ve 20 řadách. Ale nerozumím tomu správně. Každý, kdo by mi mohl pomoci, by měl poslat permutaci na můj e-mail. pauladah69@gmail.com.


1.abba
2.aabb
3.aabb
4.aabb
5.aabb
6.aabb
7.aabb
8.aabb
9.aabb
10.aabb
11.aabb
12.aabb
13.aabb
14.aabb
15.aabb
16.aabb
17.aabb
18.aabb
19.aabb
20.aabb
Tento komentář byl moderátorem webu minimalizován
tento kód nebude fungovat, protože existují dvě mnoho permutací


mělo by:

tento kód nebude fungovat, protože existuje příliš mnoho permutací


HTH
Tento komentář byl moderátorem webu minimalizován
Dobrý den, MC,
Děkuji za vřelé připomenutí, je to moje chyba. Opravil jsem to.
Díky moc!
Tento komentář byl moderátorem webu minimalizován
peki bunu listeleyecek bir program uygulama yok mu?basit sıradan bir hesaplamadan daha fazlasına ihtiyacı olan ne yapacak?
Tento komentář byl moderátorem webu minimalizován
kdo mi může poslat seznam 10 různých položek permutovaných podle 2 výsledků. tento kód ano

na tomhle nepracuji
Tento komentář byl moderátorem webu minimalizován
Dobrý den, pokud vstupní řetězec obsahuje duplicitní znaky, pak sub vytváří duplicitní permutace.
To se nestane, pokud provedete následující úpravu smyčky:

' ===========================
Pro i = 1 To xLen
Pokud Instr( Left(Str2, i - 1), Mid(Str2, i, 1) ) = 0, pak
Volání GetPermutation(Str1 + Mid(Str2, i, 1), Left(Str2, i - 1) + Right (Str2, xLen - i), xRow)
End if
další
' ===========================

Vytváření dočasných lokálních proměnných pro Mid(Str2, i, 1) a pro Left(Str2, i - 1) a vyhnutí se testu pro i=1 to zrychlí:


' ===========================
Sub GetPermutation (Str1 jako řetězec, Str2 jako řetězec, ByRef xRow jako dlouhý)
Dim i As Integer, xLen As Integer, Str2left jako String, c jako String
xLen = Len(Str2)
Pokud xLen < 2 Pak
Rozsah("A" & xRow) = Str1 a Str2
xRow = xRow + 1
Jiný
Volání GetPermutation(Str1 + Mid(Str2, 1, 1), Right(Str2, xLen - 1), xRow)
Pro i = 2 To xLen
c = střední(Str2, i, 1)
Str2left = Left(Str2, i - 1)
Pokud Instr( Str2left, c ) = 0, pak
Volání GetPermutation(Str1 + c, Str2left + Right(Str2, xLen - i), xRow)
End If
další
End If
End Sub
' ===========================

Na zdraví,
dvdm
Tento komentář byl moderátorem webu minimalizován
Ahoj!

Co se stalo pro gerar pelo mens 10 permutações?
Tento komentář byl moderátorem webu minimalizován
Dobrý den, Mateus,
Chcete-li vyřešit svůj problém, použijte níže uvedený kód: (Poznámka: pokud je více než 8 znaků, kód se spustí pomalu.)
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


Zkuste to prosím, doufám, že vám to pomůže!
Zatím zde nejsou žádné komentáře
Zanechat své připomínky
Odesílání jako host
×
Ohodnoťte tento příspěvek:
0   Postavy
Doporučená umístění