Maximale maat

[goedlichtJoost]

Hallo allemaal,

Ik heb een productie-stuk lijst.
Dit is een lijst met de volgende waardes:
- Code (dit beschrijft welk profiel het is)
- Aantal (hoeveel van dit profiel er nodig zijn)
- Lengte (lengte van deze profielen)

Een voorbeeld van deze lijst is bijgevoegd.

Nu is het zo dat hierin lengtes groter dan 6000 kunnen voorkomen, echter delen wij deze op in lengtes van 6000 en dan een rest lengte.
Is het mogelijk een macro te maken welke dit automatisch doet?

Voorbeeld:

Code Lenge Aantal
347 4000 6
505 2300 4
300 13000 2
301 5400 3


Dit zou dus moeten worden:

Code Lenge Aantal
347 4000 6
505 2300 4
300 6000 4
300 1000 2
301 5400 3

Ik hoop dat iemand mij hiermee kan helpen.
Alvast bedankt

mvg
Joost

 

[ExcelAmateur]

goedlichtJoost,


Kijk of dit wat is.

 

[goedlichtJoost]

Beste EA,

Hartelijk dank voor de snelle reactie,
Echter werkt het niet geheel.
Als ik 13000 lengte en 12 stuks invul, dan komt er te staan: 6000 x 24; 1000 x 24
Maar dit moet natuurlijk zijn 6000 * 24 en 1000 * 12
dus cel C4 moet niet keer 2.

Maar goed, nu zou ik dus eigenlijk willen, dat het in het zelfde format komt te staan. (het word namelijk ingelezen).

Dus de regel 13194 12 moet vervangen worden door:
6000 24
1194 12

Dit kan denk ik niet in een formule, maar moet echt met Visual Basic gedaan worden?

mvg
Joost

Aangepast:

Ik denk dat een visual basic formule ongeveer zo zou moeten werken.

stap 1, zoek in kolom B naar waardes >6000
stap 2, doe die waarde /6000 met afronden naar beneden (Variabele 1). en doe een REST deling, zodat je de rest houdt (Variabele 2).
stap 3, kopieer de rij waarin hij staat 1x eronder.
stap 4, je hebt nu dus 2 dezelfde rijen onder elkaar. verander in de bovenste rij de waarde uit kolom B in 6000, en de waarde van variabele 1 in kolom C (aantal).
stap 5, verander in de onderste rij van de 2, de waarde in kolom B naar de waarde van variabele 2.
stap 6, ga weer naar stap 1, zolang er waardes >6000 gevonden worden in kolom B

 

[ExcelAmateur]

Is het zo iets beter?

 

[goedlichtJoost]

Hallo EA,

De formule is nu aangepast,
Maar de opmaak moet hetzelfde blijven.
Dus ik denk dat ik toch een knop moet hebben waarop ik kan klikken om alle gegevens te controleren en aan te passen?

mvg
Joost

 

[ExcelAmateur]

Ik ben hier niet in thuis VBA code schrijven, opnemen lukt nog wel.
Je zal dus op een expert moeten wachten.

 

[goedlichtJoost]

VBA Expert?

 

[cow18]

Sub Lengtes6000()
  Dim a, i&, arr, i1&, i2&
  ReDim arr(1 To 1, 1 To 3)
  a = Sheets("blad1").Range("A1").CurrentRegion            'lees je gegevens
  With CreateObject("scripting.dictionary")                'maak een dictionary
    For i = 2 To UBound(a)                                 'loop je gegevens 1 per 1 af
      If IsNumeric(a(i, 2)) And IsNumeric(a(i, 3)) Then    '2e en 3e kolom zijn getallen
        arr(1, 1) = a(i, 1)                                '1e kolom
        i1 = a(i, 2) / 6000: If i1 > 0 Then arr(1, 2) = 6000: arr(1, 3) = i1 * a(i, 3): .Item(.Count) = arr  'indien >=6000, dan zoveel stuks van 6000
        i2 = a(i, 2) Mod 6000: arr(1, 2) = i2: arr(1, 3) = a(i, 3): .Item(.Count) = arr  'de rest
      End If
    Next

    If .Count Then
      If .Count = 1 Then ReDim arr(1 To 1, 1 To 3): .Item(.Count) = arr
      Sheets("blad1").Range("A2").Resize(.Count, UBound(arr, 2)).Value = Application.Index(.items, 0, 0)
    End If
  End With
End Sub

 

[goedlichtJoost]

:thumb::thumb::thumb::thumb::thumb:
Top! werkt perfect.
Stel dat ik de deel waarde (dus de 6000) nu variabel wil hebben.
Kan ik deze dan gewoon wijzigen naar een cel?

dus alsvolgt:

dim b = "F7"
en dan overal b invullen ipv 6000?

 

[ExcelAmateur]

Kijk of je het zo bedoel, heb het een beetje aangepast.

 

[cow18]

een foutje in het afronden !!!
boven de 0.5 wordt er naar boven afgerond als je die rode "int(...)" er niet aan toevoegt

      i1 = [COLOR="#FF0000"]Int([/COLOR]a(i, 2) / L[COLOR="#FF0000"])[/COLOR]: If i1 > 0 Then arr(1, 2) = L: arr(1, 3) = i1 * a(i, 3): .Item(.Count) = arr  'indien >=6000, dan zoveel stuks van 6000