S tímto tématem se setkáte na našich kurzech ExcelTown.
Aktuálně: kurzy můžete absolvovat jak online, tak prezenčně.

V tomto článku je popsané makro, které umožní vykreslit harmonogram vytíženosti několika pracovníků firmy. Makro je maximálně zjednodušené, ale funkční.

Zadáním je vykreslit dle seznamu pracovníků firmy (zeleně) na základě seznamu zakázek (červeně) pro vybrané datumy (šedě) harmonogram toho, kdy kdo pracuje na některé zakázce (modře). 

harmonogram

K vykreslení bude sloužit tlačítko.

Na obrázku už je harmonogram hotový, v makru je pomocí komentářů vysvětlena logika. 

Pokud Vás makro zajímá nebo si prostě chcete pohrát s VBA, můžete si soubor i s makrem stáhnout.

Sub harmonogram()
'Definice proměnných. Protože naše proměnné budou určovat číslo řádku nebo sloupce, budou to celá čísla - integery
Dim radek As Integer
Dim sloupec As Integer
Dim radek_zakazek As Integer
'Než harmonogram začneme vyplňovat, zrušíme případné původní barvy
Range(Cells(2, 2), Cells(5, 8)).Interior.ColorIndex = xlNone
'Makro projde všechny sloupce od druhého (v prvních řádcích a sloupcích jsou záhlaví řádků a sloupců)
For sloupec = 2 To 8
    'Stejně tak projde všechny řádky
    For radek = 2 To 5
        'Každá buňka v harmonogramu se "podívá", jestli neexistuje zakázka, která by jí pro příslušného člověka datumově odpovídala. Je tedy třeba projít všechny zakázky.
        For radek_zakazek = 2 To 4
            'U každé zakázky se tedy zkontroluje, jestli se shoduje jak ve jméně a současně datum buňky je stejný nebo vyšší než datum zahájení zakázky a současně stejnýá nebo nižší než datum ukončení zakázky
            If (Cells(radek, 1).Value = Cells(radek_zakazek, 14).Value) And Cells(1, sloupec).Value >= Cells(radek_zakazek, 12) And Cells(1, sloupec).Value <= Cells(radek_zakazek, 13).Value Then
            'Pokud tomu tak je, do buňky se zapíše písmenko "x"
                Cells(radek, sloupec).Interior.Color = RGB(200, 200, 255)
            'V jakémkoliv jiném případě se nestane nic, takže ukončíme podmínku
            End If
        'Postoupíme o řádek níže v řádku zakázek
        Next radek_zakazek
    'Když všechny zakázky porovnáme, přesuneme se na další řádku
    Next radek
'Když projdeme všechny řádky v harmonogramu, přesuneme se na další sloupec
Next sloupec
'A to je všechno, harmonogram je vykreslený
End Sub

 

 

S tímto tématem se setkáte na našich kurzech ExcelTown.
Aktuálně: kurzy můžete absolvovat jak online, tak prezenčně.

Napsat komentář

Vaše emailová adresa nebude publikována.

*

smazat formulářOdeslat komentář