< návrat zpět
MS Excel
Téma: Moc prosím o radu s kódem makra ![rss](./plugins/templates/wall_2C/images/icons/rss.png)
Zaslal/a Ada007 16.12.2016 23:06
Ahoj,
potřebuju dostat finální data z makra, bohužel z nějakého důvodu mi makro vůbec nedobíhá. Mám podezření na špatná zdrojová data, ale kolegyně mi to není schopná vysvětlit a tak nenašla by se tady dobrá duše, co by mi vysvětlila alespoň podle kódu, o co v tom jde? Rada zmáčkni tlačítko a čekej fakt nepomáhá a já bych ty výsledky ráda měla, případně ty podklady podle toho makra i upravila.
Díky moc za pomoc
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
Jde mi o to s jakými sloupci na jakém listě pracuje .... já to bohužel při své znalosti maker z kódu nedám
Ada007(17.12.2016 13:16)#033941 ![avatar](./pictures/avatars/no-avatar.jpg)
syd1 napsal/a:
Hele rada by byla lepší na tyhle řeči, co mi tu píšeš si najdi jinej příspěvek ....
Hele, druha rada zadarmo paklize ani tvuj sef nevi, co mas delat: vem koste a bez zametat kancelar.
A treti, pokud doopravdy chcete pomoct: na to makro se vyprdni, posli data a napis, co s nima chces UDELAT. S tim preci musis prijit TY, a ne my.
vysvětlit do češtiny, co znamená tento kód resp. co říká, že dělá:
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
a tento:
' příjmení, jméno do sloupce D
DOCH.Activate
Range("D1").Select
Selection.Copy
Range("D2:D5000").Select
ActiveSheet.Paste
Range("A2").Select
citovat
Ada007(17.12.2016 13:18)#033942 ![avatar](./pictures/avatars/no-avatar.jpg)
marjankaj napsal/a:
Ada007 napsal/a:
Ale jo :) dá se to :)
No ak si taký macher, tak to bude pre teba malina.
Ale ono to půjde :) jen na to teda vykydám sobotu no ... jsem myslela, že když se zeptám tak to půjde rychlejš
citovat
Stalker(17.12.2016 13:50)#033943 ![Stalker](./pictures/avatars/5a84a0f55ed4d.jpg)
Ada007 napsal/a:
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
Porovnává hodnoty z listu MD kmenová data ze sloupce F s listem Ukončení slouec D, L a Q. Pokud vyhoví podmínce na listu MD kmenová data do sloupce O zapíše hodnotu FALSE
Ada007 napsal/a:
' příjmení, jméno do sloupce D
DOCH.Activate
Range("D1").Select
Selection.Copy
Range("D2:D5000").Select
ActiveSheet.Paste
Range("A2").Select
V podstatě na listu Docházka zkopíruje vzorec z buňky D1 do buněk D2 až D5000
citovat
Ada007(17.12.2016 14:11)#033944 ![avatar](./pictures/avatars/no-avatar.jpg)
Stalker napsal/a:
Ada007 napsal/a:
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
Porovnává hodnoty z listu MD kmenová data ze sloupce F s listem Ukončení slouec D, L a Q. Pokud vyhoví podmínce na listu MD kmenová data do sloupce O zapíše hodnotu FALSE
Ada007 napsal/a:
' příjmení, jméno do sloupce D
DOCH.Activate
Range("D1").Select
Selection.Copy
Range("D2:D5000").Select
ActiveSheet.Paste
Range("A2").Select
V podstatě na listu Docházka zkopíruje vzorec z buňky D1 do buněk D2 až D5000
Ty jo moc děkuju, vážně
citovat
Anonym(18.12.2016 0:11)#033945 ![avatar](./pictures/avatars/no-avatar.jpg)
Neee! To už je opravdu všechno? To je škoda.
citovat
marjankaj(18.12.2016 15:59)#033949 ![avatar](./pictures/avatars/no-avatar.jpg)
@anonym
A nestačí ti kým sa preroluješ na koniec tých "makier"?
![2](./plugins/templates/wall_2C/images/smileys/2.gif)
No zdravého človeka by to nenapadlo.
citovat
Ada007(18.12.2016 16:02)#033950 ![avatar](./pictures/avatars/no-avatar.jpg)
marjankaj napsal/a:
@anonym
A nestačí ti kým sa preroluješ na koniec tých "makier"? No zdravého človeka by to nenapadlo.
:) díky moc za rady, už to mám
citovat
marjankaj(18.12.2016 16:31)#033951 ![avatar](./pictures/avatars/no-avatar.jpg)
Ada007 napsal/a:
marjankaj napsal/a:@anonym
A nestačí ti kým sa preroluješ na koniec tých "makier"? No zdravého človeka by to nenapadlo.
:) díky moc za rady, už to mám
No ešte by si nám neznalým mohla prezradiť, čo to makro MÁ robiť.
Čo naozaj robí si už prezradila. Vraj nerobí nič.
![4](./plugins/templates/wall_2C/images/smileys/4.gif)
Inak taký výsledok sa dá dosiahnuť aj bez makra.
citovat