< návrat zpět

MS Excel


Téma: třídění rss

Zaslal/a 30.11.2014 20:15

Dobrý večer, potřeboval bych poradit, vytvořil jsem makro na třídění, ale ještě to není ono lidi jak se mi kopírujou tak se mi stane že jsou tam dvakrát.
Jedná se mi o to mám tabulku s lidmi a potřebuju je nakopírovat do skupin a hodnota musí být takovou jakou navolím (100, 200, 300, atd.) . K úplné dokonalosti by to bylo že navolím i do skupiny počet osob (min jsou 3 a max 7). Děkuji za rady.

Příloha: zip22593_pokus-vyber.zip (37kB, staženo 18x)
Zaslat odpověď >

Strana:  « předchozí  1 2
#022625
avatar
Tak na prvním místě je podmínka 3 až 7 lidí ve skupině, nemůže být 15 lidí ve skupině.
Dále to bude tedy asi složitější, takže jednotky nemusí být stejné ve skupině a můžou být v rozmezí 100 až 600.
Takže to zkusím shrnout:
3 až 7 lidí ve skupině - je jedno kolik bude skupin ale lidi se nesmí opakovat
jednotky v rozmezí 100 až 600 pro libovolnou skupinu, takže aby to dobře vycházelo tak například v první skupině bude 100 ave druhé 200 a ve třetí 100.citovat
icon #022626
eLCHa

MiPa napsal/a:

Nevím proč, kde dělám chybu, ale nic mi to nedělá


Ono to samozřejmě dělá a dělá to přesně to co píšu v příspěvku a v komentáři procedury. Vyhledá to všechny existující kombinace pro součet 100. Jenže tam není žádný výstup.

Pokud přidáte řádek, např.:Sub subStart()
Dim sResult() As String
ReDim sResult(1 To 1)

Call subFindCombinations(sResult, Range("C1:C15"), 100)

Range("A25").Resize(UBound(sResult), 1).Value = Application.Transpose(sResult)
End Sub
a spustíte na listu List1 tak od buňky A25 to vypíše všechny kombinace (ta čísla chápejte jako čísla řádků). Toto je podle mne nejlepší způsob - jedna procedura pro všechny kombinace. Váš kód jsem nestudoval, ale dělal bych to takto.
Takže teď můžete projet pole sResult a vybrat si ty kombinace, které Vám vyhovují.citovat
icon #022627
eLCHa
Pokud upravím kód například takto:Sub subStart()
Const ITEMS_COUNT As Byte = 4
Const SUM As Integer = 200

Dim sResult() As String
ReDim sResult(1 To 1)

Call subFindCombinations(sResult, Range("C1:C15"), SUM)

Dim sCombinations() As String
ReDim sCombinations(1 To 1) As String

Dim i As Long
For i = 1 To UBound(sResult)
If Len(sResult(i)) - Len(Replace(sResult(i), ";", vbNullString)) = (ITEMS_COUNT - 1) Then
If Not sCombinations(1) = vbNullString Then
ReDim Preserve sCombinations(1 To UBound(sCombinations) + 1)
End If
sCombinations(UBound(sCombinations)) = sResult(i)
End If
Next i

Range("A25").CurrentRegion.ClearContents
Range("A25").Resize(UBound(sCombinations), 1).Value = Application.Transpose(sCombinations)
End Sub
vypíše mi všechny kombinace pro součet 200 a počet 4. Není tam řešena jedinečnost. Zaprvé si z Vašeho zadání pořád nejsem 100% jistý, co chcete a za druhé už nemám moc času. Takže buď si musíte dodělat sám nebo Vám tady někdo pomůže.

Poznámka - pokud nepotřebujete všechny kombinace, můžete omezení prvků samozřejmě řešit už v rámci procedury subFindCombinations - což trošku zkrátí běh kódu...citovat
icon #022628
eLCHa
Tak a omlouvám se za spam - ale ještě jsem provedl integraci procedury subStart do Vašeho userformuPrivate Sub CommandButton1_Click()
Dim sResult() As String
ReDim sResult(1 To 1)

Call subFindCombinations(sResult, Range("C1:C15"), CLng(jednotkyTB.Text))

Dim sCombinations() As String
ReDim sCombinations(1 To 1) As String

Dim i As Long
For i = 1 To UBound(sResult)
If Len(sResult(i)) - Len(Replace(sResult(i), ";", vbNullString)) = (CByte(lidiTB.Text) - 1) Then
If Not sCombinations(1) = vbNullString Then
ReDim Preserve sCombinations(1 To UBound(sCombinations) + 1)
End If
sCombinations(UBound(sCombinations)) = sResult(i)
End If
Next i

Range("A25").CurrentRegion.ClearContents
Range("A25").Resize(UBound(sCombinations), 1).Value = Application.Transpose(sCombinations)

Unload Me
End Sub


poznámka - v tomto případě musí buď být procedury subFindCombinations a subAddItem v modulu userformu nebo procedura subFindCombinations nesmí být Private.citovat

Strana:  « předchozí  1 2

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse

Čas od do

elninoslov • 19.4. 8:46

Čas od do

jarek1111 • 18.4. 13:46

Čas od do

lubo • 18.4. 11:13

Čas od do

jarek1111 • 18.4. 8:32

Čas od do

jarek1111 • 18.4. 8:31

Makro smyčka

MilanKop • 18.4. 7:18

Makro smyčka

elninoslov • 18.4. 0:18