Van ruwe file een nieuwe uploadfile maken

Antonisse1 · 31 jan 2012

Goedemorgen,
ik loop tegen het volgende aan in een voorraadsysteem, zie bijgaande Excel-file. Kolom A tm E is mijn overzicht dat ik wekelijks wens te verbeteren.
Na de verbeteringen moet het overzicht aan de volgende voorwaarden voldoen:
1. Een item mag geen negatieve voorraad meer hebben, negatieve voorraad moet voor elk item naar 0 worden geboekt.
2. Elk item kan in meerdere magazijnen en kan verschillende lot-codes en locatiecodes hebben.
In kolom G tm N staat de gewenste uploadfile. Als ik deze gegevens upload heb ik mijn voorraad weer in orde.
Heeft iemand echter een idee hoe ik automatisch (met formules in Excel) tot deze uploadfile kan komen? Zelf loop ik een beetje vast, al lukt een deel mij wel. Wat ik bijvoorbeeld lastig vind is, hoe haal ik de juiste waarde uit kolom B voor kolom G? Hoe kan ik Excel hier naar laten zoeken?
Ik maakte gebruik van veel ALS formules:
Bijvoorbeeld:
• ALS een waarde in kolom E negatief is, zet deze hoeveelheid dan positief in kolom L.
• De positieve voorraad in kolom E moet altijd voldoende zijn om te worden overgeboekt naar de negatieve, anders ontstaat elders weer een negatieve regel.
• In kolom G tm N komt alleen een regel als in kolom E een negatieve waarde staat.
Opmerkingen:
• In dit voorbeeld gaat het om de fictieve items AA tm HH. In werkelijkheid heb ik een lijst van enkele duizenden.
• Soms staat alle voorraad al positief en goed (zie item DD).

Mijn vraag is eigenlijk, is dit mogelijk te automatiseren of is dit een onmogelijke taak?

Heel hartelijk dank voor uw hulp!!
Groet,
David Antonisse

wampier · 31 jan 2012

Staat de layout altijd zoals nu opgegeven, dus gegroepeerd per item? Wat gebeurt er als er negens genoeg voorraad is om de tekorten aan te vullen?

In principe is dit met VBA op te lossen, maar de route via VBA is nogal rigide. De layout moet dan kloppen. Dus altijd beginnen bij A3, gegroepeerd per item, geen lege regels etc. Overigens is het met formules ook wel grotendeels mogelijk, maar dan moet je alsnog gedeeltelijk gaan slepen voor elk item. (tenzij een formule guru een universele oplossing ziet?)

Antonisse1 · 31 jan 2012

Reactie

Heel hartelijk dank alvast voor uw reactie!

In principe staan de kolommen zo gepositioneerd zoals ze nu staan. De output zou ik in principe op allerlei manieren kunnen sorteren, de kolom 'aanwezig' kan gesorteerd worden op voorraad aanwezig (bijv. van laag naar hoog).

Als er nergens genoeg voorraad is om de negatieve voorraad op te lossen mag er eigenlijk geen correctieregel verschijnen.

(De negatieve voorraden ontstaan overigens door verschepingen uit het verkeerde magazijn, er had eerst intern een magazijnoverboeking moeten plaatsvinden)

Ik kan een beetje in VBA programmeren, echter ik zou niet weten hoe ik dit moet oplossen. Waar ik een beetje op vast loop, is het aantal mogelijkheden dat er zijn. Met ALS formules gaat het volgens mij heel omslachtig. Een ander probleem is: hoe krijg ik alles zo netjes op 1 regel (kolom G tm N)? Eventueel mag de output ook verschijnen na nog een aantal handmatige bewerkingen, zoals een draaitabel maken of zo.

Mocht u een idee hebben over de VBA programmering, dan zou u me erg helpen. Ik moet deze correcties eigenlijk wekelijks maken en handmatig is dit behoorlijk tijdrovend. Misschien heeft u voor mij een voorbeeld hoe het verhaal zou moeten lopen in VBA, hoe het schema eruit moet zien bijvoorbeeld (ja/nee, indien ja ga dan naar, indien nee ga dan naar enz.)

Heel hartelijk dank alvast!

Groet,
David Antonisse

wampier · 31 jan 2012

Ik ben eruit.

Het ziet er een beetje vervaarlijk uit. Maar ik wilde het zo modulair mogelijk houden. het werkt met je huidige voorbeeld. Ik heb alles nu onder elkaar geplakt zodat het een solide lijst wordt. Ik heb een aantal use-cases doorlopen en volgens mij is het redelijk robuust. Let wel op: niet aan te vullen voorraden worden als gevraagd helemaal niet gemeld!

Code:

Option Explicit
Option Base 0
Type opslag
    loc As Range
    waarde As Long
End Type

Sub test()
Dim begin As Range
Dim eind As Range
Dim i As Long
Set begin = [a3]
Set eind = LookAhead(begin.Value, begin)
While eind.Offset(1).Value <> ""
    Call CheckRange(begin, eind)
    Set begin = Range(eind.Offset(1), eind.Offset(1))
    Set eind = LookAhead(begin.Value, begin)
Wend
Call CheckRange(begin, eind)

End Sub

Function LookAhead(waarde As String, startlocatie As Range) As Range
Dim einde As Range
Dim cell As Range
Set einde = startlocatie.Offset(300000).End(xlUp)
For Each cell In Range(startlocatie, einde)
    If cell.Value <> waarde Then
        Set LookAhead = cell.Offset(-1)
        Exit For
    End If
Next cell

End Function

Sub CheckRange(begin As Range, eind As Range)

Dim i As Long
Dim j As Long
Dim paren() As Range
Dim tekorten() As opslag
ReDim tekorten(0)
ReDim paren(1, 0)
Dim cell As Range

For Each cell In Range(begin, eind)
    Set tekorten(UBound(tekorten)).loc = cell
    tekorten(UBound(tekorten)).waarde = cell.Offset(0, 4).Value
    ReDim Preserve tekorten(UBound(tekorten) + 1)
Next cell

ReDim Preserve tekorten(UBound(tekorten) - 1)

For i = 0 To UBound(tekorten)
    If tekorten(i).waarde < 0 Then
        For j = 0 To UBound(tekorten)
            If tekorten(j).waarde >= Abs(tekorten(i).waarde) Then
                tekorten(j).waarde = tekorten(j).waarde - Abs(tekorten(i).waarde)
                tekorten(i).waarde = 0
                Set paren(0, UBound(paren, 2)) = tekorten(i).loc
                Set paren(1, UBound(paren, 2)) = tekorten(j).loc
                ReDim Preserve paren(1, UBound(paren, 2) + 1)
                Exit For
            End If
        Next j
    End If
Next i

If UBound(paren, 2) Then
    ReDim Preserve paren(1, UBound(paren, 2) - 1)
    For i = 0 To UBound(paren, 2)
        With [g50000].End(xlUp).Offset(1)
            .Value = paren(1, i).Offset(0, 1).Value
            .Offset(0, 1).Value = paren(0, i).Offset(0, 1).Value
            .Offset(0, 2).Value = paren(0, i)
            .Offset(0, 3).Value = paren(1, i).Offset(0, 2).Value
            .Offset(0, 4).Value = paren(0, i).Offset(0, 2).Value
            .Offset(0, 5).Value = Abs(paren(0, i).Offset(0, 4).Value)
            .Offset(0, 6).Value = paren(1, i).Offset(0, 3).Value
            .Offset(0, 7).Value = paren(0, i).Offset(0, 3).Value
        End With
    Next i
End If

End Sub

Antonisse1 · 31 jan 2012

Reactie

Ik ga het straks eens even rustig bekijken, maar ik wil u nu al vast heel erg bedanken voor al dit werk! Fantastisch! Ik sta ervan te kijken!

Kan ik deze code gewoon in een module zetten met ALT F11 en dan de macro proberen te runnen?

Hoe gebruik ik het?

Heel erg bedankt!

Groetjes,
David

P.S. Ik zou het leuk vinden nog wat informatie te ontvangen over hoe u het heeft gemaakt of hoe het werkt, als u daar nog tijd voor kunt vinden. Ik wil u nu in ieder geval alvast heel erg bedanken, fantastisch wat u heeft geschreven!

wampier · 31 jan 2012

Inderdaad, gewoon in een module plakken en "test" runnen. Speel er even mee en als je vragen hebt zal ik die proberen te beantwoorden. De opzet is makkelijker dan het lijkt. het is redelijk veel tekst maar het algoritme is redelijk eenvoudig.

Er zijn een aantal stappen:

- knip de lijst in stukjes aan de hand van "item"
- binnen elk stukje wordt een tijdelijke lijst geladen met de waarden van kolom "E" en het betreffende rij-nr
- indien in de lijst negatieve waarden worden gevonden wordt geprobeerd een overeenkomstige positieve waarde te vinden
- De waarden worden weggestreept en de regels die elkaar opheffen opgeslagen
- De regels die elkaar opheffen worden 1 voor 1 in kolom G-N geplaatst

Antonisse1 · 31 jan 2012

Reactie

Ik heb het al even uitgeprobeerd met nieuw gedownloade gegevens, het lijkt echt fantastisch! Ik ga vanavond eens even kritisch bekijken hoe het programma is opgebouwd. Ik sta echt met verbazing te kijken dat het mogelijk is! Super!

Heel erg bedankt! Als u nog wat uitleg zou kunnen sturen zou dat fantastisch zijn! Ik wil u zeer hartelijk danken voor alle tijd die u hier in heeft gestoken!

Vriendelijke groet,
David Antonisse

wampier · 31 jan 2012

Kritisch bekijken is belangrijk, omdat ik natuurlijk maar een beperkt aantal dingen uit heb kunnen proberen. Ik zal, als ik dadelijk nog wat tijd kan vinden, even wat commentaar plakken in mijn file.

Code:

' Om te zorgen dat alles loopt als verwacht
Option Explicit
Option Base 0
' mijn eigen type opslag voor opslaan van rij en bijbehorende waarde
Type opslag
    loc As Range 'cell in kolom "A"
    waarde As Long 'overeenkomstige waarde in kolom "E"
End Type

'hoofdroutine
Sub test()

Dim begin As Range
Dim eind As Range
Dim i As Long
' beginpunt in kolom "A"
Set begin = [a3]
' bijbehorend eindpunt bij eerste "item" zoeken
Set eind = LookAhead(begin.Value, begin)
'door blijven gaan totdat kolom "A" leeg is
While eind.Offset(1).Value <> ""  'doorgaan tot "leeg"
    Call CheckRange(begin, eind) 'item range afhandelen
    Set begin = Range(eind.Offset(1), eind.Offset(1)) 'nieuwe begin is vorige eind +1
    Set eind = LookAhead(begin.Value, begin) 'nieuw einde ophalen
Wend
Call CheckRange(begin, eind) 'laatste blok nog afhandelen

End Sub

' functie zoekt einde van een blok gelijke "items"
Function LookAhead(waarde As String, startlocatie As Range) As Range
Dim einde As Range
Dim cell As Range
Set einde = startlocatie.Offset(300000).End(xlUp) 'selecteer onderste cell kolom A
For Each cell In Range(startlocatie, einde) 'loop tussen begin en laatste item in kolom A
    If cell.Value <> waarde Then 'als item veranderd, bijvoorbeeld AA naar BB
        Set LookAhead = cell.Offset(-1) 'selecteer vorige cell
        Exit For 'ophouden met verder kijken
    End If
Next cell

End Function

'eigenlijke werkpaard
Sub CheckRange(begin As Range, eind As Range)

Dim i As Long
Dim j As Long
Dim paren() As Range
Dim tekorten() As opslag 'opslag is mijn eigen type van helemaal bovenaan
ReDim tekorten(0) 'tekorten leeg maken
ReDim paren(1, 0) 'paren leeg maken
Dim cell As Range

For Each cell In Range(begin, eind) 'van begin tot eind lopen
    Set tekorten(UBound(tekorten)).loc = cell 'kopie maken van de regel
    tekorten(UBound(tekorten)).waarde = cell.Offset(0, 4).Value 'kopie maken van de waarde in kolom "E"
    ReDim Preserve tekorten(UBound(tekorten) + 1) 'nieuwe ruimte maken in tekorten
Next cell

' laatste "lege" waarde afsnijden
ReDim Preserve tekorten(UBound(tekorten) - 1)

'loop door alle tijdelijke waarden
For i = 0 To UBound(tekorten)
    If tekorten(i).waarde < 0 Then 'indien een negatieve waarde
        For j = 0 To UBound(tekorten) 'loop door alle tijdelijke waarden
            If tekorten(j).waarde >= Abs(tekorten(i).waarde) Then 'indien er een item is dat de negatieve waarde kan opvangen
                tekorten(j).waarde = tekorten(j).waarde - Abs(tekorten(i).waarde) 'positieve waarde verminderen met het tekort
                tekorten(i).waarde = 0 'tekort op 0 zetten
                Set paren(0, UBound(paren, 2)) = tekorten(i).loc ' rij met tekort opslaan
                Set paren(1, UBound(paren, 2)) = tekorten(j).loc ' rij met overschot opslaan
                ReDim Preserve paren(1, UBound(paren, 2) + 1) 'nieuwe ruimte maken voor meer paren
                Exit For 'niet verder zoeker naar andere mogeljkheden, tekort is opgelost
            End If
        Next j
    End If
Next i

If UBound(paren, 2) Then 'indien er minstens 1 oplossing is voor een tekort
    ReDim Preserve paren(1, UBound(paren, 2) - 1) 'leeg paar afsnijden
    For i = 0 To UBound(paren, 2) 'door alle paren lopen
        With [g50000].End(xlUp).Offset(1) 'eerste beschikbare cell in kolom G
            .Value = paren(1, i).Offset(0, 1).Value 'G is overschot-rij kolom "B"
            .Offset(0, 1).Value = paren(0, i).Offset(0, 1).Value 'H is tekort-rij kolom "B"
            .Offset(0, 2).Value = paren(0, i) 'etc
            .Offset(0, 3).Value = paren(1, i).Offset(0, 2).Value
            .Offset(0, 4).Value = paren(0, i).Offset(0, 2).Value
            .Offset(0, 5).Value = Abs(paren(0, i).Offset(0, 4).Value)
            .Offset(0, 6).Value = paren(1, i).Offset(0, 3).Value
            .Offset(0, 7).Value = paren(0, i).Offset(0, 3).Value
        End With
    Next i
End If

End Sub

met commentaar

Antonisse1 · 31 jan 2012

Reactie

Het leek inderdaad wel dat ik hier en daar een kleine verschuiving zag, maar ik vind uw programmeerwerk bewonderenswaardig!

Ik ga denk ik zometeen nog een file posten voor iets waar ik al lang handmatig dingen voor doe, ook dit is tijdrovend. Als ik hier weer zie wat er mogelijk is met programmeren, dan verbaas ik me weer ronduit.

Nogmaals heel hartelijk dank en ik zal regel voor regel doornemen wat die programma nu eigenlijk doet. Bepaalde zaken die u heeft gebruikt beheers ik niet.

Je weet eigenlijk wel dat met programma's veel mogelijk is, maar om je ideeën te vertalen naar VBA is nog niet allemaal even makkelijk.

Groet,
David Antonisse

wampier · 31 jan 2012

Het belangrijkste is het in stukken hakken van de taak in de juiste stapjes. Er zijn meerdere manieren om je doel te bereiken in dit geval. Je hebt zelf ook al een belangrijk deel gedaan door de informatie helder vorm te geven en de juiste manier om tot een antwoord te komen beschreven. Dit is eigenlijk al 50% van het denkwerk

Je werkt daarna terug: "Ik heb 2 regels nodig, een tekort en een overschot, beide moeten over hetzelfde item gaan"

probleem1: hoe vind ik een groep regels behorende tot 1 item?
probleem2: hoe vind ik binnen een groep tekort en overschot?

Probleem 1 moet opgelost worden voor probleem 2. Probleem 1 is opgelost door gewoon bovenaan te beginnen en naar beneden te lopen totdat kolom A een andere waarde bevat dan de voorgaande. probleem 2 is opgelost door 2 lussen te nemen; de eerste lus identificeert tekorten, de tweede vind bijbehorende overschotten.

Daarna is het een kwestie van de 2 regels overschrijven in kolom G en verder.

EDIT Voor optimale resultaten is het het beste om de lijst verder te sorteren met een secundaire sort op kolom "E" als je vooral de kleine voorraadjes ook wil benutten

Antonisse1 · 1 feb 2012

Reactie

Heel erg bedankt voor alle remarks. Ik zal proberen het programma voor mijn tweede verzoek te schrijven. Dank u heel hartelijk voor alle tijd die u hier in heeft gestoken! Fantastisch!!!

Groet,
David Antonisse

Van ruwe file een nieuwe uploadfile maken

Antonisse1

Gebruiker

Bijlagen

wampier

Meubilair

Antonisse1

Gebruiker

wampier

Meubilair

Antonisse1

Gebruiker

wampier

Meubilair

Antonisse1

Gebruiker

wampier

Meubilair

Antonisse1

Gebruiker

wampier

Meubilair

Antonisse1

Gebruiker

Nieuwste berichten

Wij waarderen jouw privacy