< návrat zpět

MS Excel

Téma: Moc prosím o radu s kódem makra rss

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

Zaslat odpověď >
Strana:  « předchozí  1 2 3
Ada007(17.12.2016 13:16)#033941
avatar

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").Selectcitovat
Ada007(17.12.2016 13:18)#033942
avatar

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

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ž D5000citovat
Ada007(17.12.2016 14:11)#033944
avatar

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
Neee! To už je opravdu všechno? To je škoda.citovat
marjankaj(18.12.2016 15:59)#033949
avatar
@anonym
A nestačí ti kým sa preroluješ na koniec tých "makier"? 2 No zdravého človeka by to nenapadlo. 9citovat
Ada007(18.12.2016 16:02)#033950
avatar

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ámcitovat
marjankaj(18.12.2016 16:31)#033951
avatar

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 Inak taký výsledok sa dá dosiahnuť aj bez makra. 2citovat

Strana:  « předchozí  1 2 3

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse

Čas od do

lubo • 19.4. 16:30

Makro smyčka

MilanKop • 19.4. 10:46

Makro smyčka

elninoslov • 19.4. 9:02

Čas od do

elninoslov • 19.4. 8:46

Čas od do

jarek1111 • 18.4. 13:46

Čas od do

lubo • 18.4. 11:13

Čas od do

jarek1111 • 18.4. 8:32