< návrat zpět

MS Excel


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

Zaslal/a 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:  1 2 3   další »
#033920
avatar
"S jakými sloupci na jakém listě pracuje..."
Najdi si klíčová slova "Cells". Před nimi máš název listu, hned na začátku makra pak máš přiřazení zkratek (např. Set MD = Worksheets("MD kmenová data")). Příkaz Cells má pak strukturu Cells(číslo řádku, sloupec). Pokud máš číslo řádku jako proměnnou, tak si musíš najít, čím je naplněna (např. For r_u = 2 To 10000 znamená, že čísla řádků jdou postupně v cyklu od 2 do 10000).

No, jak myslíš, že ti makro nedobíhá? Spadne? Jaká hláška vyskočí? Jaký řádek je žlutě? Případně vlož nějakou přílohu, na které by se to dalo otestovat...
P.citovat
#033921
avatar
Bohužel soubor můžu poskytnout jen takto osekané. Ale na jednom listu bylo víc jak 10000 řádků tak jestli to není třeba i tím. No a je to tak, že makro spustím a běží 30 minut a nic se neděje, excel se tváří, že pracuje, ale vidět to nikde není

r_u a jen tohle znamená přesně co?citovat
#033923
avatar
Kód napsal dobrák stylem "po mně potopa" a navíc podle zkušeností z jiného programovacího jazyka (viz ty GoTo). Takže nechtějte po nás věštění z křišťálové koule, jestliže to má fungovat. Dejte to jednomu z nás zadat a oceňte ho.
Buď budeme mít data a slovní vyjádření, co to má dělat, nebo si holt necháte tuhle hrací skřínku.citovat
#033924
avatar
Takže to běží 30 minut, a co pak? Doběhne to?
P.citovat
#033925
avatar
No já bych právě ráda věděla, co to má dělat, protože ta dobrá duše, co to psala to není schopná nikomu vysvětlit, co to má dělat. ... proto to sem celé píšu ...., to že to není OK vím bohužel samacitovat
#033926
avatar
Nedoběhlo to zatím ani jednoucitovat
#033927
Stalker

Ada007 napsal/a:

No já bych právě ráda věděla, co to má dělat, protože ta dobrá duše, co to psala to není schopná nikomu vysvětlit, co to má dělat. ... proto to sem celé píšu ...., to že to není OK vím bohužel sama


Největší průser je, že ani ta dobrá duše neví co to má dělat.

Pokud sem nedáš vzorek dat na kterých se do dá odzkoušet, tak si to budeš muset odkrokovat (klávesou F8) sama.
Na jednu část monitoru sešit na druhou editor VBA. Kurzor postavíš na začátek makra a mačkáš F8.

Zde je celý kód v txt
http://www.jaknaoffice.cz/2-forum/?id=2397citovat
icon #033928
eLCHa
Cells(r_u, "L"
Sloupec Lcitovat
#033929
avatar
Tak snad
Příloha: zip33929_vzor.zip (177kB, staženo 24x)
citovat
#033930
avatar

eLCHa napsal/a:

Cells(r_u, "L"
Sloupec L


Díky díky, už aspoň koukám s čím tam přesně pracuje .... ale pořád nepobírám, co tam dělá .....citovat

Strana:  1 2 3   další »

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

odpocet a storno tl.

PavDD • 28.3. 8:53

odpocet a storno tl.

Začátečník • 26.3. 14:39

odpocet a storno tl.

PavDD • 26.3. 10:22

odpocet a storno tl.

elninoslov • 26.3. 7:50

odpocet a storno tl.

PavDD • 26.3. 7:26

odpocet a storno tl.

elninoslov • 25.3. 22:34

odpocet a storno tl.

Začátečník • 25.3. 15:09