Læg mærke til at den sidste "pakke" indeholder den rest, der er tilbage, og kan altså godt falde uden for intervallet på 36-44 stk.
Jeg vil mene at det skulle være muligt at oprette et regneark, hvor man ved indtastning af tallene, automatisk fik de såkaldte pakker "spyttet" ud i den rigtige rækkefølge.
For r = startrakke To lastrow 'slet tidligere fraark.Range(Cells(r, startkolonne), Cells(r, startkolonne + 30)).ClearContents Next r
For r = startrakke To lastrow tal = fraark.Cells(r, 1) tal2 = tal t = 0 While tal2 > 16 fraark.Cells(r, startkolonne + t) = 8 tal2 = tal2 - 8 t = t + 1 Wend If tal2 >= 8 Then fraark.Cells(r, startkolonne + t) = RoundUp(tal2 / 2) t = t + 1 fraark.Cells(r, startkolonne + t) = RoundD(tal2 / 2) t = t + 1 Else fraark.Cells(r, startkolonne + t) = tal2 End If Next r
slutrakke = t c = 0 Sum = 0 r = startrakke For r = startrakke To slutrakke 'find den sidste kolonne c = fraark.Cells(r, startkolonne).SpecialCells(xlLastCell).Column If c > c2 Then c2 = c Next r c = 0 r = startrakke
While r < slutrakke + 1 If fraark.Cells(r, startkolonne + c) > 0 Then Sum = fraark.Cells(r, startkolonne + c) + Sum c = c + 1 If Sum >= 36 Then fraark.Cells(r, c2 + 1).Value = Sum Sum = 0 End If Else c = 0 r = r + 1 End If Wend fraark.Cells(r, c2 + 1).Value = Sum End Sub
For r = startrakke - 1 To lastrow + 1 'slet tidligere fraark.Range(Cells(r, startkolonne), Cells(r, startkolonne + 30)).ClearContents Next r
fraark.Cells(startrakke - 1, startkolonne) = "Mellemregningerne" For r = startrakke To lastrow tal = fraark.Cells(r, 1) t = 0 While tal > 16 fraark.Cells(r, startkolonne + t) = 8 tal = tal - 8 t = t + 1 Wend If tal >= 8 Then fraark.Cells(r, startkolonne + t) = RoundUp(tal / 2) t = t + 1 fraark.Cells(r, startkolonne + t) = RoundD(tal / 2) t = t + 1 Else fraark.Cells(r, startkolonne + t) = tal End If Next r
c = 0 Sum = 0 r = startrakke For r = startrakke To lastrow 'find den sidste kolonne lastcol = fraark.Range("IV5").End(xlToLeft).Column If lastcol > c2 Then c2 = lastcol Next r
fraark.Cells(startrakke - 1, c2 + 2) = "Pakker" r = startrakke While r < lastrow + 1 If fraark.Cells(r, startkolonne + c) > 0 Then Sum = fraark.Cells(r, startkolonne + c) + Sum c = c + 1 If Sum >= 36 Then fraark.Cells(r, c2 + 2).Value = Sum Sum = 0 End If Else c = 0 r = r + 1 End If Wend fraark.Cells(r, c2 + 2).Value = Sum 'sæt rest End Sub
Private Function RoundUp(v As Single) As Single 'runder af til heltal RoundUp = Round(v) If Round(v) < v Then RoundUp = Round(v) + 1 Else End If End Function Private Function RoundD(v As Single) As Single 'runder ned til heltal Dim t As Integer t = v If t > v Then RoundD = t - 1 Else RoundD = t End If End Function
Tak for dit forslag, kan du evt. guide mig med indtastningen af det ovenstående i Excel, da mit kendskab til regneark, begrænser sig til forholdsvis simple funktioner, så er jeg kommet lidt på dybt vand her.
Hvor skal al den kode indtastes ??
På forhånd tak for hjælpen, og tak for det fine arbejde indtil videre, jeg ser frem til at afprøve resultatet. ;-)
Du skal skifte dette afsnit ud (ellers går det galt ved de store tal)
c = 0 Sum = 0 r = startrakke c2 = 0 For r = startrakke To lastrow 'find den sidste kolonne lastcol = fraark.Cells(r, 256).End(xlToLeft).Column If lastcol > c2 Then c2 = lastcol Next r
Det begynder at ligne noget, men der er stadig nogle småting, som ikke helt fungerer optimalt, når jeg prøver.
Er det muligt, at resultatet i pakkerne, kan ligge så tæt på 40 som muligt, da feks. 37 og 4 bliver returneret som 37 og 4, i stedet for som 41, hvilket ville være mere optimalt. ?
Ved høje tal (over 76) , går det galt ved sammentælningen i pakker og alle tal bliver ikke talt sammen.
Tallet 8 blev delt med 2 og blev til 4 og 4, det skal returneres som 8, jeg har rettet fra 8 til 9 i koden
Wend If tal >= 9 Then
Ved indtastning af foreksempel 8 forskellige tal og kørsel af makroen, for derefter at rette til feks. kun 5 tal og så køre makroen igen, er der flere af de ”gamle” mellemregninger, som bliver ”hængende” i regnearket.
Det er tæt på at være helt perfekt, men der mangler lige det sidste i at fungere optimalt.
Ang. størrelsen af de tal som jeg kan forvente at skulle bruge, kan der godt forekomme enkelttal, som nærmer sig 1500.
Mellemregningerne er ikke noget must. De ville være rare at have, men kan godt undværes. Jeg tænkte på om man evt. ikke kunne returnere dem på et seperat ark.?
Ang. stakkene, så vil det mest optimale være, hvis værdien kunne ligge så tæt på 40 stk. som muligt, og samtidig indenfor den fastsatte difference på de 36-44 stk.
Er det muligt, at returnere værdierne af stakkene i en form for tabel, da der i ekstreme tilfælde, kan være helt op til 50-60 stakke. Så var det lidt nemmere at overskue hvis det var listet i en tabel, men det er heller ikke noget must.
ottere = 0 For r = startrakke To lastrow tal = fraark.Cells(r, 1) t = 0 While tal > 16 ottere = ottere + 1 tal = tal - 8 t = t + 1 Wend If tal >= 9 Then 'for tal mellem 9-16 fraark.Cells(r, startkolonne) = ottere fraark.Cells(r, startkolonne + 1) = RoundUp(tal / 2) t = t + 1 fraark.Cells(r, startkolonne + 2) = RoundD(tal / 2) t = t + 1 Else ' tal < 9 fraark.Cells(r, startkolonne + 1) = tal fraark.Cells(r, startkolonne + 2) = 0 End If ottere = 0 fraark.Cells(r, startkolonne + 4) = fraark.Cells(r, startkolonne) * 8 + fraark.Cells(r, startkolonne + 1) + fraark.Cells(r, startkolonne + 2) Next r
Sum = 0 t = 0 r = startrakke pnr = 0 ' pakker nr Sum = 0 Dim pakker(500) As Integer While r < lastrow + 1 ottere = fraark.Cells(r, startkolonne) 'hent antal ottere igen: While ottere > 0 And Sum < 36 ottere = ottere - 1 Sum = Sum + 8 Wend If ottere > 0 Then pakker(pnr) = Sum pnr = pnr + 1 Sum = 0 GoTo igen Else If Sum + fraark.Cells(r, startkolonne + 1) < 44 Then 'hent rest 1 Sum = Sum + fraark.Cells(r, startkolonne + 1) If Sum + fraark.Cells(r, startkolonne + 2) < 44 Then 'hent rest 2 Sum = Sum + fraark.Cells(r, startkolonne + 2) Else pakker(pnr) = Sum pnr = pnr + 1 Sum = fraark.Cells(r, startkolonne + 2) ' start med rest 2 End If Else pakker(pnr) = Sum pnr = pnr + 1 Sum = fraark.Cells(r, startkolonne + 1) ' start med rest 1 End If End If r = r + 1 Wend pakker(pnr) = Sum ' rest
' udskriv pakker rpakker = 5 ' startrække efter indtastet værdier cantal = 10 ' antal kolonne for pakker rc = 0 'række count for pakker cc = 0 ' kolonne count for pakker
fraark.Cells(lastrow + rpakker, startkolonne).Value = "Pakker" For t = 0 To pnr fraark.Cells(lastrow + rpakker + 1 + rc, startkolonne + cc).Value = pakker(t) cc = cc + 1 If cc > cantal Then cc = 0 rc = rc + 1 End If Next t End Sub
Private Function RoundUp(v As Single) As Single 'runder af til heltal RoundUp = Round(v) If Round(v) < v Then RoundUp = Round(v) + 1 Else End If End Function Private Function RoundD(v As Single) As Single 'runder ned til heltal Dim t As Integer t = v If t > v Then RoundD = t - 1 Else RoundD = t End If End Function
ottere = 0 For r = startrakke To lastrow tal = fraark.Cells(r, 1) t = 0 While tal > 16 ottere = ottere + 1 tal = tal - 8 t = t + 1 Wend If tal >= 9 Then 'for tal mellem 9-16 fraark.Cells(r, startkolonne) = ottere fraark.Cells(r, startkolonne + 1) = RoundUp(tal / 2) t = t + 1 fraark.Cells(r, startkolonne + 2) = RoundD(tal / 2) t = t + 1 Else ' tal < 9 fraark.Cells(r, startkolonne + 1) = tal fraark.Cells(r, startkolonne + 2) = 0 End If ottere = 0 fraark.Cells(r, startkolonne + 4) = fraark.Cells(r, startkolonne) * 8 + fraark.Cells(r, startkolonne + 1) + fraark.Cells(r, startkolonne + 2) Next r
Sum = 0 t = 0 r = startrakke pnr = 0 ' pakker nr Sum = 0 Dim pakker(500) As Integer While r < lastrow + 1 ottere = fraark.Cells(r, startkolonne) 'hent antal ottere igen: While ottere > 0 And Sum < 36 ottere = ottere - 1 Sum = Sum + 8 Wend If ottere > 0 Then pakker(pnr) = Sum pnr = pnr + 1 Sum = 0 GoTo igen Else If Sum + fraark.Cells(r, startkolonne + 1) < 44 Then 'hent rest 1 Sum = Sum + fraark.Cells(r, startkolonne + 1) If Sum + fraark.Cells(r, startkolonne + 2) < 44 Then 'hent rest 2 Sum = Sum + fraark.Cells(r, startkolonne + 2) Else pakker(pnr) = Sum pnr = pnr + 1 Sum = fraark.Cells(r, startkolonne + 2) ' start med rest 2 End If Else pakker(pnr) = Sum pnr = pnr + 1 Sum = fraark.Cells(r, startkolonne + 1) ' start med rest 1 Sum = fraark.Cells(r, startkolonne + 2) + Sum ' forsæt med rest 2
End If End If r = r + 1 Wend pakker(pnr) = Sum ' rest
' udskriv pakker rpakker = 5 ' startrække efter indtastet værdier rantal = 10 ' antal rækker for pakker rc = 0 'række count for pakker cc = 0 ' kolonne count for pakker
fraark.Cells(lastrow + rpakker, startkolonne).Value = "Pakker" For t = 0 To pnr fraark.Cells(lastrow + rpakker + 1 + rc, startkolonne + cc).Value = pakker(t) rc = rc + 1 If rc > rantal Then rc = 0 cc = cc + 1 End If Next t End Sub
Private Function RoundUp(v As Single) As Single 'runder af til heltal RoundUp = Round(v) If Round(v) < v Then RoundUp = Round(v) + 1 Else End If End Function Private Function RoundD(v As Single) As Single 'runder ned til heltal Dim t As Integer t = v If t > v Then RoundD = t - 1 Else RoundD = t End If End Function
Nu ser det ud til at det fungerer helt perfekt, efter de oplysninger, som jeg har givet.
Flot arbejde.
Der er bare lige et par småting, som, hvis det er muligt at kontrolere, ville gøre det helt perfekt.
Jeg har desværre ikke fået oplyst at det mest optimale for mig, ville være at hvis de returnerede pakkers værdi kan ligge så tæt på 40 som muligt, så vil det være helt perfekt.
Når jeg foreksempel bruger følgende tal
40 1 1 2 2 2 40
Returnerer den pakker som følgende 42 38 8
Det ville være mest optimalt for mig, hvis der returneres pakker som følgende 40 40 8
Jeg ser frem til at høre fra dig, og nu er vi vist ved at være klar til et svar, så der kan komme nogle point din vej.
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
