< návrat zpět

MS Excel

Téma: Opakování rutiny rss

Zaslal/a Raders486 2.1.2017 14:16

Ahoj.

Níže uvedenou rutinu potřebuji provést na všech listech v sešitu.

Poradíte prosím jak zapsat aniž bych pořád využíval Call Krok1(Fallse) a pak zase Call Krok2(False) a takto 54x 1

Jedná se o tuto rutinu

Sub Krok2(x As Boolean)
Workbooks("Plány kovo včera.xlsm").Activate
Sheets("20381").Select

Dim dDate As Date
Dim strDate As String
Dim lDate As Long, LR As Long
LR = Range("A" & Rows.Count).End(xlUp).Row

dDate = DateSerial(2017, 1, 0)
lDate = dDate

ActiveSheet.Range("F1:F" & LR).AutoFilter Field:=6, Criteria1:=">=" & lDate - 60, _
Operator:=xlAnd, Criteria2:="<" & lDate + 3

Range("R1").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[2]C:R[2000]C)"
ActiveCell.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
x = True
End Sub

Snad jsem to popsal pochopitelně 1
Děkuji

Zaslat odpověď >
Jeza.m(2.1.2017 15:27)citovat#034132
Jeza.m
Třeba ...
Public Sub DELEJ()
Workbooks("Plány kovo včera.xlsm").Activate
For Each sh In ActiveWorkbook.Sheets
sh.Select
Krok2 False
Next
End Sub

Sub Krok2(x As Boolean)

Dim dDate As Date
Dim strDate As String
Dim lDate As Long, LR As Long
LR = Range("A" & Rows.Count).End(xlUp).Row

dDate = DateSerial(2017, 1, 0)
lDate = dDate

ActiveSheet.Range("F1:F" & LR).AutoFilter Field:=6, Criteria1:=">=" & lDate - 60, Operator:=xlAnd, Criteria2:="<" & lDate + 3
Range("R1").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[2]C:R[2000]C)"
ActiveCell.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
x = True

End Sub

šlo by to i optimalizovat vše do jedné funkce tak aby se pokaždé nedeklarovaly proměnné, ale takhle to je pro názornost nejrychlejší.

M@
xlnc(2.1.2017 19:09)citovat#034139
avatar
Poslal bych vám s tím nejradši za dveře... oba.

Zadání?
Ukázka listu?
Smysluplnost x?
Věčný Select, Activate. Ach jo.
Raders486(2.1.2017 19:59)citovat#034140
avatar
5 njn to jsem celý já, ale jinak děkuji Jeza.m jeho nakopnutí stačilo a dostatečně pomohlo. Využil jsem to i jinde.

Co se Selecte týká, snažím se na to již dávat pozor, ale ne vždy se mi to podaří odbourat. NJN učím se.

Děkuji za tyto skvělé stránky a báječné lidi co sem chodí a nám méně zdatným otevřou oči či pomohou.

Moc díky.
xlnc(2.1.2017 20:40)citovat#034141
avatar
Jen tak od boku a jakože mimo: Pojem Tabulka vám něco říká?
Raders486(3.1.2017 0:44)citovat#034143
avatar
No sice mi uniká smysl této otázky, ale říká, viz příloha.
Příloha: rar34143_vyhodnoceni-planu-rk.rar (150kB, staženo 34x)

Uživatelské menu

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

Menu

Formulář Faktura

Formulář Faktura IV

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

Helios iNuvio

Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.

On-line nástroje