Handlujemy wieloma różnymi towarami. Wozimy je tam i z powrotem: samochodami, statkami i samolotami. Przechowujemy w magazynach. Sprzedajemy, kupujemy… i bez przerwy musimy kontrolować ilości w magazynach oraz ceny, żeby dużo zyskać, a mało stracić… To wszystko nazywamy logistyką i jest to przedsięwzięcie naprawdę bardzo skomplikowane. A mój mini program LOGISTYKA próbuje ogarnąć te tysiące wpisów o sprzedaży i zakupie w jakieś rozsądne zestawienie. Co więcej – na podstawie poprzednich wpisów próbuje przewidzieć przyszłość!

Z| jaką sytuacją miałem do czynienia. 4 kontenerowce dowożą towary: w różnych odstępach czasu i na różnej wielkości palet. Towary na paletach przechowywane są w magazynach. Musi być ich na tyle, żeby wystarczyło – cały czas trwa sprzedaż, ale też nie może być ich zbyt dużo – za powierzchnię magazynową się dużo płaci. Program wylicza minimalne dostawy, żeby zyski były jak największe przy minimalnych opłatach za magazyny… i to wszystko widać w tabelce i na wykresie.

mgr inż. Wacław Libront

Nie mogę zdradzić komu i za ile go tworzyłem, ale planowanie z jego pomocą pozwala zaoszczędzić ogromne kwoty. Zdradzam kod źródłowy, bo program nie pracuje już na "moje utrzymanie"

Sub Makro15()
On Error GoTo błąd
    'numer wiersza zaznaczonej komórki
    w = Selection.Row
    'a może wylicz dostawę dopiero wtedy gdy zaczyna brakować towaru
    'gdy współczynniki minimalne są większe od współczynników aktualnych
    'współczynnik sprzedaż/zakup i zapas w tygodniach
    WSM = Cells(w, 9)
    WZT = Cells(w, 10)
    'minimalne zapasy
    WSMmin = Cells(w, 11)
    WZTmin = Cells(w, 12)
    OKR = Cells(w, 5)
    'gdy jeden ze współczynników mniejszy to szukaj wyniku
    If WSM < WSMmin Or WZT < WZTmin Then
      adres1 = "O" + LTrim(Str(w))
      adres2 = "M" + LTrim(Str(w))
      'według którego współczynnika szukamy
      'na wszelki wypadek oba sprawdzamy
      'a jak oba mniejsze to najpierw pierwszy ale potem i tak według tygodniowego
      If WSMmin <> Empty Then
        Range(adres1).GoalSeek Goal:=WSMmin, ChangingCell:=Range(adres2)
      Else
        Range(adres1).GoalSeek Goal:=WZTmin / OKR, ChangingCell:=Range(adres2)
      End If
    Else ' jak nie sukasz wyniku to wyzeruj dostawę
      'nie zerujemy bo zerowało M4 gdy wybrany ten wiersz
      'Cells(w, 13) = "" 'kolumna w której wyliczana dostawa co 1,5 tygodnia
    End If
Exit Sub
błąd:
    MsgBox "proszę wprowadzić brakujące dane"
End Sub

Sub szukajALL15()
On Error GoTo błąd
  w1 = Selection.Row
  k1 = Selection.Column
  'sprawdzaj od 6 do 20 wiersza
  For w = 6 To 50
  If Cells(w, 4) > 0 Then 'gdy jest sprzedaż to liczymy
    Cells(w, 13).Select
    Makro15
  End If
  Next w
  Cells(w1, k1).Select
błąd:
Resume Next
End Sub

Sub Makro6()
On Error GoTo błąd
    'numer wiersza zaznaczonej komórki
    w = Selection.Row
    'a może wylicz dostawę dopiero wtedy gdy zaczyna brakować towaru
    'gdy współczynniki minimalne są większe od współczynników aktualnych
    'współczynnik sprzedaż/zakup i zapas w tygodniach
    WSM = Cells(w, 9)
    WZT = Cells(w, 10)
    'minimalne zapasy
    WSMmin = Cells(w, 11)
    WZTmin = Cells(w, 12)
    OKR = Cells(w, 5)
    'gdy jeden ze współczynników mniejszy to szukaj wyniku
    If WSM < WSMmin Or WZT < WZTmin Then
      adres1 = "R" + LTrim(Str(w))
      adres2 = "P" + LTrim(Str(w))
      'według którego współczynnika szukamy
      'na wszelki wypadek oba sprawdzamy
      'a jak oba mniejsze to najpierw pierwszy ale potem i tak według tygodniowego
      If WSMmin <> Empty Then
        Range(adres1).GoalSeek Goal:=WSMmin, ChangingCell:=Range(adres2)
      Else
        Range(adres1).GoalSeek Goal:=WZTmin / OKR, ChangingCell:=Range(adres2)
      End If
    Else ' jak nie sukasz wyniku to wyzeruj dostawę
      'Cells(w, 15) = "" 'kolumna w której wyliczana dostawa co 6 tygodni
    End If
Exit Sub
błąd:
    MsgBox "proszę wprowadzić brakujące dane"
End Sub

Sub szukajALL6()
On Error GoTo błąd
  w1 = Selection.Row
  k1 = Selection.Column
  'sprawdzaj od 6 do 20 wiersza
  For w = 6 To 50
  If Cells(w, 4) > 0 Then 'gdy jest sprzedaż to liczymy
    Cells(w, 15).Select
    Makro6
  End If
  Next w
  Cells(w1, k1).Select
błąd:
Resume Next
End Sub


Sub analiza()
On Error GoTo błąd
  nazwa = ActiveSheet.Name
  Sheets("PLAN").Select
  Range("A2:F202").Select
  Selection.ClearContents
  Range("A2").Select
  Sheets(nazwa).Select
  'analiza dla wybranego wiersza
  WW = Selection.Row
  'trzeba zaraz na początku obliczyć jaka kolejna dostawa
  
  'czy stałe dostawy
  DDD = Sheets("PLAN").Range("G1")
  'sztuki czy palety sztuki-prawda
  'przeliczamy w sztukach tylko wyniki w paletach zapisujemy
  SZT = Sheets("PLAN").Range("G2")
  'dostawa co ile tygodni
  TOS = Sheets("ORDER").Range("M4")
  
  'sprzedaż w okresie OKR
  'podzielimy na połówki bo dostawa co 1,5 tyg
  SPR = Sheets("ORDER").Cells(WW, 4) 'Range("D6")
  'minimalny zapas magazynowy w sprzedażach np. 2 - dwie sprzedaże
  OKR = Sheets("ORDER").Cells(WW, 5) 'Range("E6")
  'stan magazynu - będzie się zmieniać
  MAG = Sheets("ORDER").Cells(WW, 6) 'Range("F6")
  'ile mieści się na palecie
  PAL = Sheets("ORDER").Cells(WW, 7) 'Range("G6")
  'ile sprzedaży w magazynie - współczynnik
  WSP = Sheets("ORDER").Cells(WW, 11) 'Range("K6")
  'na ile tygodni ma być towaru w magazynie
  TYG = Sheets("ORDER").Cells(WW, 12) 'Range("L6")
  
  'na tyle tygodni podana sprzedaż i od razu co tyle tyg korekta
  DOS = Sheets("ORDER").Cells(WW, 13) 'Range("M6")
  DOS = DOS * PAL
  
  kor = False 'korekta dostaw
  
  'gdy obliczamy dostawy za każdym razem
  If DDD = False Then DOS = DOSTAWA(MAG, WW) * PAL
  
  w = 1
  t = 0 'tygodnie
  d = 0 'dostawy
  k = 0 'korekty
  Do
    'kolejny wiersz - każdy to pół tygodnia
    w = w + 1
    'tydzień
    Sheets("PLAN").Cells(w, 1) = t
    'sprzedaż w sztukach na pół tygodnia
    If SZT Then
      Sheets("PLAN").Cells(w, 2) = SPR / OKR / 2
    Else
      Sheets("PLAN").Cells(w, 2) = SPR / OKR / 2 / PAL
    End If
    'stan magazynu
    If SZT Then
      Sheets("PLAN").Cells(w, 5) = MAG
    Else
      Sheets("PLAN").Cells(w, 5) = MAG / PAL
    End If
    'nowy stan po sprzedaży półtygodniowej
    MAG = MAG - SPR / OKR / 2 'sprzedaż co pół tygodnia - ubywa z magazynu
    
    'ale kolejna dostawa już idzie, więc obliczenie korekto po dostawie
    If k = OKR Then 'nowa korekta dostaw
      kor = True 'nie od razu ale po kolejnej dostawie
      k = 0 'zliczanie odnowa
      'zznaczyć korektę
      Sheets("PLAN").Cells(w, 3) = "X"
      'czy dostawy stałe, czy obliczamy po każdym okresie OKR
      If DDD = False Then
        DOS1 = DOSTAWA(MAG, WW) * PAL
      Else
        DOS1 = DOS
      End If
      'DOS = DOS1
      'nowa dostawa zapisać
      If SZT Then
        Sheets("PLAN").Cells(w, 6) = DOS1
      Else
        Sheets("PLAN").Cells(w, 6) = DOS1 / PAL
      End If
    End If
    
    'nowa dostawa dodana do do magazynu
    If d = TOS Then
      d = 0
      'korekta dostaw po kolejnej dostawioe bo już statek szedł
      MAG = MAG + DOS
      'zapisać dostawę
      If SZT Then
        Sheets("PLAN").Cells(w, 4) = DOS
      Else
        Sheets("PLAN").Cells(w, 4) = DOS / PAL
      End If
      'sprawdzenie czy korekta , a realizacja dopiero po następnej dostawie
      If kor Then
        DOS = DOS1
        kor = False
      End If
      
    End If
    
    t = t + 0.5
    d = d + 0.5
    k = k + 0.5
  Loop Until t > 100
Exit Sub
błąd:
  MsgBox "coś poszło nie tak - może brak danych lub wybrałeś zły wiersz"
End Sub

'wyliczamy dostawę
'wywołujemy z arkusza gdzie tabela z danymi
Function DOSTAWA(m, WW As Variant) As Variant
  Cells(WW, 6).Select
  Cells(WW, 6) = m
  Makro15
  DOSTAWA = Cells(WW, 13)
End Function