MS Excel

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.

Zaslat odpověď >

Strana: « předchozí 1 2

MiPa(1.12.2014 22:02)#022625

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

eLCHa(2.12.2014 6:28)#022626

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 Suba 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

eLCHa(2.12.2014 6:52)#022627

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 Subvypíš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

eLCHa(2.12.2014 6:57)#022628

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

Téma: třídění

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje