Sub Sestava() ' ' Makro1 Makro ' Set MD = Worksheets("MD kmenová data") Set DOCH = Worksheets("Docházka") Set HOD = Worksheets("Hodiny - LOGA") Set NAP = Worksheets("Napomenutí") Set VYJ = Worksheets("Výjimky") Set ZL = Worksheets("Zlepšováky") Set BOD = Worksheets("Kritéria počtu") ' příjmení, jméno do sloupce D DOCH.Activate Range("D1").Select Selection.Copy Range("D2:D5000").Select ActiveSheet.Paste Range("A2").Select 'datumy dle výjimek For r_v = 2 To 500 If VYJ.Cells(r_v, "B").Value = "" Then GoTo konec4 For r_m = 2 To 5000 If MD.Cells(r_m, "F").Value = "" Then GoTo konec3 If MD.Cells(r_m, 6).Value = VYJ.Cells(r_v, 1).Value Then MD.Cells(r_m, "H").Value = VYJ.Cells(r_v, "C").Value GoTo konec3 End If Next r_m konec3: Next r_v konec4: ' přidělení bodů For r_h = 2 To 10000 If HOD.Cells(r_h, "C").Value = "" Then GoTo konec6 For r_m = 2 To 5000 If MD.Cells(r_m, "F").Value = "" Then GoTo konec5 If MD.Cells(r_m, "F").Value = HOD.Cells(r_h, "C").Value Then If (HOD.Cells(r_h, "E").Value = "121" Or HOD.Cells(r_h, "E").Value = "122" Or HOD.Cells(r_h, "E").Value = "111") And HOD.Cells(r_h, "f").Value >= 37.5 Then If MD.Cells(r_m, "H").Value < BOD.Cells(3, "A").Value Then MD.Cells(r_m, "X").Value = 300 ElseIf MD.Cells(r_m, "H").Value < BOD.Cells(4, "A").Value Then MD.Cells(r_m, "X").Value = 200 End If End If End If Next r_m konec5: Next r_h konec6: 'Žižka + Batko For r_m = 2 To 10000 If MD.Cells(r_m, "F").Value = "" Then GoTo konec15 If MD.Cells(r_m, "F").Value = 17162 Or MD.Cells(r_m, "F").Value = 65640 Then If MD.Cells(r_m, "H").Value < BOD.Cells(3, "A").Value Then MD.Cells(r_m, "X").Value = 300 ElseIf MD.Cells(r_m, "H").Value < BOD.Cells(4, "A").Value Then MD.Cells(r_m, "X").Value = 200 End If End If Next r_m konec15: ' extra body For r_z = 2 To 100 If ZL.Cells(r_z, "B").Value = "" Then GoTo konec2 For r_m = 2 To 5000 If MD.Cells(r_m, "F").Value = "" Then GoTo konec1 If MD.Cells(r_m, "F").Value = ZL.Cells(r_z, "B").Value Then MD.Cells(r_m, "Y").Value = ZL.Cells(r_z, "E").Value Next r_m konec1: Next r_z konec2: 'vynulování absencí For r_h = 2 To 10000 If HOD.Cells(r_h, "C").Value = "" Then GoTo konec8 For r_m = 2 To 5000 If MD.Cells(r_m, "F").Value = "" Then GoTo konec7 If MD.Cells(r_m, "F").Value = HOD.Cells(r_h, "C").Value Then If HOD.Cells(r_h, "E").Value = "515" Then MD.Cells(r_m, "X").Value = 0 End If Next r_m konec7: Next r_h konec8: 'ukončovací dopis nebo ukončení For r_d = 2 To 10000 If DOCH.Cells(r_d, "E").Value = "" Then GoTo konec10 For r_m = 2 To 5000 If MD.Cells(r_m, "F").Value = "" Then GoTo konec9 If (MD.Cells(r_m, 6).Value = DOCH.Cells(r_d, 5).Value) And (DOCH.Cells(r_d, "M").Value = "ANO" Or DOCH.Cells(r_d, "K").Value <> "") Then MD.Cells(r_m, "X").Value = 0 GoTo konec9 End If Next r_m konec9: Next r_d konec10: 'napomenutí For r_n = 2 To 1000 If NAP.Cells(r_n, "C").Value = "" Then GoTo konec12 For r_m = 2 To 5000 If MD.Cells(r_m, "F").Value = "" Then GoTo konec11 If MD.Cells(r_m, "F").Value = NAP.Cells(r_n, "A").Value Then MD.Cells(r_m, "X").Value = 0 Next r_m konec11: Next r_n konec12: 'ukončení Set UKO = Worksheets("Ukončení") For r_u = 2 To 10000 If UKO.Cells(r_u, "E").Value = "" Then GoTo konec14 For r_m = 2 To 5000 If MD.Cells(r_m, "F").Value = "" Then GoTo konec13 If (MD.Cells(r_m, "F").Value = UKO.Cells(r_u, "E").Value) And (UKO.Cells(r_u, "L").Value <= UKO.Cells(1, "Q").Value) Then MD.Cells(r_m, "O").Value = "False" GoTo konec13 End If Next r_m konec13: Next r_u konec14: End Sub Sub ukončit() Set UKO = Worksheets("Ukončení") Set MD = Worksheets("MD kmenová data") For r_u = 2 To 10000 If UKO.Cells(r_u, "D").Value = "" Then GoTo konec14 For r_m = 2 To 5000 If MD.Cells(r_m, "F").Value = "" Then GoTo konec13 If (MD.Cells(r_m, "F").Value = UKO.Cells(r_u, "D").Value) And (UKO.Cells(r_u, "L").Value <= UKO.Cells(1, "Q").Value) And (UKO.Cells(r_u, "L").Value <> "") Then MD.Cells(r_m, "O").Value = "False" GoTo konec13 End If Next r_m konec13: Next r_u konec14: End Sub