Moja przygoda z mleczarniami rozpoczęła się w 1997 roku. Początkowo program wspomagał rejestrowanie skupu mleka i naliczanie wypłat, a po wejściu Polski do UE został rozszerzony o system kwot mlecznych. 50 arkuszy z mnóstwem formuł, 20 formatek z oknami dialogowymi, ponad 7000 wierszy kodu i 30000 znaków. Być może teraz moi uczniowie zrozumieli, dlaczego przez tyle lat „katowałem” ich zadaniami związanymi z mleczarnią.

Jak oblicza się wypłatę dla rolnika? Mogę zdradzić sekrety, ale tylko w ogólnym zarysie. Mleczarnia skupuje od rolnika mleko i bada je na zawartość tłuszczu oraz obecność bakterii i komórek somatycznych. Na tej podstawie wyliczana jest tzw. klasa mleka - najlepiej gdyby zawsze była to klasa E, czyli ekstra. Współczynniki są tajne, wzory skomplikowane, ale bierze się pod uwagę trzy ostatnie miesiące i wylicza za pomocą średnich geometrycznych i średnich ważonych. Do wyliczenia wypłaty dla rolnika wystarczają trzy parametry: litry mleka, tłuszcz i klasa oraz szereg bonusów opisanych szczegółowo w dodatkowych parametrach. Teraz wystarczy wydrukować faktury, przelewy, szereg zestawień, itp.

{gallery}stories/2016/cyfroweprojekty_plan/mleczarnia{/gallery}

Przykładowe formuły stosowane w tabelach – w rzeczywistości rozdzielone są na mniejsze w osobnych komórkach:

Wyliczenie klasy mleka

=JEŻELI(JEŻELI(EQ13<>"";WYSZUKAJ.POZIOMO(EQ13;wspk;2;PRAWDA);"")<jeŻeli(eo13<>"";WYSZUKAJ.POZIOMO EO13;wspk;2;PRAWDA);"");JEŻELI(CZY.LICZBA(JEŻELI(CZY.LICZBA(EL13);WYSZUKAJ.POZIOMO(JEŻELI(SUMA(ED12:EG12)>0;ŚREDNIA.GEOMETRYCZNA(ED12:EG12)*1000;"")/1000;wspB;2;PRAWDA);""));WYSZUKAJ.POZIOMO(JEŻELI(SUMA(EI13:EK13)>0;ŚREDNIA.GEOMETRYCZNA(EI13:EK13)*1000;"")/1000;wspS;2;PRAWDA);"");EO13)

Wyliczenie wypłatay

=litr1*(WYSZUKAJ.POZIOMO(procent1;wspt;2;PRAWDA)*procent1+JEŻELI(CZY.PUSTA(klasa1);;WYSZUKAJ.POZIOMO(klasa1;wspk;2;))+podstawa)+litr2*(WYSZUKAJ.POZIOMO(procent2;wspt;2;PRAWDA)*procent2+JEŻELI(CZY.PUSTA(klasa2);;WYSZUKAJ.POZIOMO(klasa2;wspk;2;))+podstawa)+JEŻELI(LUB(JEŻELI(CZY.PUSTA(klasa1);;WYSZUKAJ.POZIOMO(klasa1;wspk;2;))>bez_premii;JEŻELI(CZY.PUSTA(klasa2);;WYSZUKAJ.POZIOMO(klasa2;wspk;2;))>bez_premii);litry*(WYSZUKAJ.POZIOMO(litry;wspl;2;PRAWDA)-podstawa);)+(należność1+należność2+premia+DY13)*VAT+JEŻELI(CZY.PUSTA(DW13);;dodatkowy*litry)+JEŻELI(CZY.PUSTA(DU13);;zbiornik*litry)+ JEŻELI(CZY.PUSTA(DS13);;atestacja*litry)+potrącenia+ dopłata*litry

Co to są (a właściwie były do 2015 roku) kwoty mleczne? Unia Europejska, broniąc się przed nadpodażą mleka narzuciła wszystkim krajom ograniczenia w produkcji mleka. Każdy litr wyprodukowany ponad indywidualną dla każdego rolnika kwotę mleczną skutkował nałożeniem na niego kary finansowej. W związku z tym należało przygotować program do sprostania unijnej machinie urzędniczej i wymianie danych z Agencją Restrukturyzacji i Modernizacji Rolnictwa.

mgr inż. Wacław Libront

Fragment kodu źródłowego: (tworzenie unijnego formularza P8F3) i całość dla zainteresowanych

'wypełnianie i drukowanie formularza P8f3_____________________________________________P8f3
'dane pobierane z arkusza kwotowanie
Sub FormularzP8f3()
On Error GoTo błąd
  kolumna = KtóraKolumna()
  Worksheets("personalne").Select
  Sort_nr 'posortowanie według numerów

For wojew = 4 To 19
nWoj = Trim(Worksheets("Parametry").Cells(wojew, 12))
If nWoj <> "" Then
If nWoj = "12" Then nWoj = ""

  'wyczyść obszar roboczy
  Worksheets("P8f3").Select
  Range(Cells(11, 2), Cells(1010, 13)).Select
  Selection.ClearContents
  Rows("11:1010").RowHeight = 12.75 'na wszelki wypadek od razu powrót
  Cells(1, 1).Select
  Worksheets("P8f3").Range("C3") = Worksheets("Parametry").Range("E49") & "  " & Worksheets("Parametry").Range("E50")
  Worksheets("P8f3").Range("C4") = Worksheets("Parametry").Range("E51")
  Worksheets("P8f3").Range("D6") = Worksheets("Parametry").Range("E64")
  Worksheets("P8f3").Range("F6") = Worksheets("kwotowanie").Cells(1, kolumna + 1)
  'przelatujemy po wszystkich i wybieramy tych z IKM
  w8 = 10 'ile wierszy wypełnionych w P8f3
  
  For w = 4 To 1003
    ' sprawdzamy IRZT z miesiąca, bo jeśli był kiedykolwiek to go m wpisanego w miesiącu
    irzt = Worksheets("kwotowanie").Cells(w, kolumna + 7)
    If irzt > 0 Then
         'sprawdzamy województwo
    If nWoj = "0" Or Left(Worksheets("personalne").Cells(w, 17), 2) = nWoj Then
      IKMdos = Worksheets("kwotowanie").Cells(w, kolumna + 8) 'IKM do skupienia
      sumaKGkor = FsumaKGkor(kolumna, w)
      IIRwyk = FIIRwyk(kolumna, w)
      ' trzeba znaleźć ostatniego dobrego IKM i u od tego odjąć
      'szukamy ostatniego ikm
      ikm = 0
      For k = 10 To kolumna Step 10
        a = Worksheets("kwotowanie").Cells(w, k + 8)
        If a > 0 Then ikm = a
      Next k
      ponad = 0
      sumaKGkorWYK = FsumaKGkorWYK(kolumna, w)
      ponad = -(ikm - sumaKGkorWYK)
    'powinno pokazywać nie tych co przekroczyli w tym miesiącu
    'ale tych co zapłacili do tej pory cokolwiek agencji kol-6 plus poprzednie miesiące
    'dlatego sprawdzamy sumę zaliczek
    sumaZAL = FsumaZAL(kolumna, w)
    If sumaZAL > 0 Then
      w8 = w8 + 1
      Worksheets("P8f3").Cells(w8, 2) = Worksheets("personalne").Cells(w, 3) 'nazwisko i imię
      Worksheets("P8f3").Cells(w8, 3) = Worksheets("kwotowanie").Cells(w, 6) 'nip rozsz
      Worksheets("P8f3").Cells(w8, 4) = IKMdos 'IKM do skupienia
      Worksheets("P8f3").Cells(w8, 5) = irzt 'IRZT z ostatniego miesiąca
      If ponad > 0 Then
        Worksheets("P8f3").Cells(w8, 6) = ponad
      Else
        Worksheets("P8f3").Cells(w8, 6) = 0 'ponad kwotę
      End If
      Worksheets("P8f3").Cells(w8, 7) = 0 'bez zaliczki od VIII.2010 sumaZAL
      
      'liczymy zaliczkę tylko w tym miesiącu
      sumaKGzal = Worksheets("kwotowanie").Cells(w, kolumna + 5)
      sumaKGzalpop = Worksheets("kwotowanie").Cells(w, kolumna - 10 + 5)
      KGzal = FKGzal(kolumna, w)
      Worksheets("P8f3").Cells(w8, 8) = -KGzal
      Worksheets("P8f3").Cells(w8, 11) = sumaKGzal
      Worksheets("P8f3").Cells(w8, 12) = sumaKGzalpop
      If kolumna = 10 Then
        sumaZALpop = 0
      Else
        sumaZALpop = FsumaZAL(kolumna - 10, w)
      End If
      zalMies = sumaZAL - sumaZALpop
      Worksheets("P8f3").Cells(w8, 9) = 0 'bez zaliczki od VIII.2010 zalMies

    End If 'sprawdzenie ponad
    End If 'woj
    End If 'ikm
  Next w
  Calculate 'żeby wyliczyło sumy

  'drukowanie
  Rows("11:1010").RowHeight = 12.75 'na początku
  'zertować wiersze bez wartości
  adresLG = LTrim(Str(w8 + 1))
  adresPD = LTrim(Str(1010))
  obszar = adresLG & ":" & adresPD
  Rows(obszar).RowHeight = 0
  'obszar do druku
  adresLG = "A1"
  adresPD = "I" & LTrim(Str(1015))
  obszar = adresLG & ":" & adresPD
  Range(obszar).Select
  ActiveSheet.PageSetup.PrintArea = Selection.Address
  ActiveSheet.PrintPreview
  Range("A1").Select
End If 'czy jest województwo w personalne
Next wojew 'kolejne województwa

Exit Sub
błąd:
    MsgBox "Wystąpił błąd w procedurze FormularzP8f3-Mkwotowanie"
End Sub 'FormularzP8f3