
Program na vypocet matematickych uloh ze srovnanim vysledku
Krasny den preji vsem.
Predem dekuji za jakoukoli radu.
Potrebuji prosim pomoct s jednim programkem. Nebo spise zdali takovy vlastne je. Mam ruzne dva priklady ktere je potreba vypocitat a najit stejny vysledek. Prvni pozice cisel se ale vzdy meni. Priklad: kombinace cisel 2 3 6 5 4 *65 2,3,6,5,4 jsou cisla kterym by mel program menit pozice. Ale i cisla treba po dvou tedy pr. 45 54 76 67 *3 Snad se vyjdruji zpravne.
Budu moc rada za kazdou radu.
Skúšal som ten VBA kód, ktorý som sem už skôr vložil v Exceli 2010. Permutáciu 7 čísiel excel ešte zvládol, ale 8 čísiel už je mimo jeho rozsah.
Stačí Ti Katkaa aj takéto riešenie?
Urcite ano!!
vložiť VBA kód do Excelu:
klávesová zkratka Alt+F11 --> v menu VBA: Insert --> Module --> do prázdného okna vpravo kopírujte nasledujúci kód:
Option Explicit
' PGC Jan 2014
' Calculates all possible permutations without repetition of a set
' Set in A1, down. Result in C1, down and accross. Clears C:Z.
Sub PermutationsWRAll()
Dim vElements As Variant, vresult As Variant
Dim lRow As Long, i As Long
vElements = Application.Transpose(Range("A1", Range("A1").End(xlDown)))
Columns("C:Z").Clear
lRow = 1
For i = 1 To UBound(vElements)
ReDim vresult(1 To i)
Call PermutationsWR(vElements, i, vresult, lRow, 1, 1)
Next i
End Sub
Sub PermutationsWR(vElements As Variant, p As Long, vresult As Variant, lRow As Long, iElement As Integer, iIndex As Integer)
Dim i As Long, j As Long
Dim b As Boolean
For i = 1 To UBound(vElements)
b = True
For j = 1 To iIndex - 1
If vresult(j) = vElements(i) Then
b = False
Exit For
End If
Next j
If b Then
vresult(iIndex) = vElements(i)
If iIndex = p Then
lRow = lRow + 1
Range("C" & lRow).Resize(, p) = vresult
Else
Call PermutationsWR(vElements, p, vresult, lRow, i + 1, iIndex + 1)
End If
End If
Next i
End Sub
Priklad: pre hodnoty aa, bb, cc urobí tento kód toto:
aa
bb
cc
aa bb
aa cc
bb aa
bb cc
cc aa
cc bb
aa bb cc
aa cc bb
bb aa cc
bb cc aa
cc aa bb
cc bb aa
Takže bude potrebné najprv vymazať tie riadky, ktoré neobsahujú kompletne všetky hodnoty. Potom v ďalšom stĺpci môžeš hodnoty spojiť funkciou =CONCATENATE(C11;D11;E11) - kde C11, D11, E11 sú bunky, ktoré chceš spojiť.
do stĺpca A vložiť pod seba čísla, ktoré chceš zamienať a potom spustiť makro (klávesovou skratkou ALT+F8 a Spustiť)
Vyzkousela jsem, je to super. Ale ma to chibicku. Kdyz zadam napr cisla 1,1,2,3 vyhodi mi to kombinace pouze z 1,2,3. Jakmile jsou cisla stejna excel je zhodnoti jen jako jedno.
mzmz díky, prelúskam si to dodatočne, to volanie s viacerými argumentami a ich využitie je pre mňa zatiaľ neznámou...
Katkaa, keďže neviem upraviť priložené makro, použil by som trik:
namiesto niektorého z opakujúcich sa čísel by som použil iné, napr namiesto 1,1,2,3 by som jednu z jedničiek nahradil napr 9, takže by sa vyrobili variácie vytvorené z číslic 1,9,2,3.
Potom by som označil všetky naplnené stĺpce a dal nahradiť 9-u 1-ou. Musíš si však uvedomiť, že Ti tam vzniknú duplicity ALE excel duplicity odstrániť VIE. Takže najprv z vytvorených variácií, kde už máš nahradené všetky 9-y 1-ami vyhodíš všetky neúplné, do nového stĺpca dáš funkciu concatenate a odstrániš duplicity v stĺpci funkcie concatenate. Potom aplikuješ funkciu, ktorej výsledok potrebuješ zistiť, aby si porovnala s výsledkami iného rozpisu.
Ak budeš mať viac opakujúcich sa čísel (číslic), je treba ich zas na začiatku rozlíšiť, teda napr namiesto 1,1,2,3,1 nahraď trebárs za: 1x,1y,2,3,1z
potom v rozpisoch nahradíš všetky 1x za 1, 1y za 1 a 1z za 1 a podobne pri iných opakujúcich sa vstupných hodnotách...