< návrat zpět

MS Excel


Téma: Opakování rutiny rss

Zaslal/a 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ěď >

#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@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.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.citovat
#034141
avatar
Jen tak od boku a jakože mimo: Pojem Tabulka vám něco říká?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 32x)
citovat

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

Tlac s farebneho

ivana1 • 19.6. 22:16

GRAF teploty

Scraper • 18.6. 15:34

Vyhledat dnešní datum když je číslo jako text

veny • 17.6. 13:56

Vyhledat dnešní datum když je číslo jako text

Ontik • 17.6. 12:07

Zaokrouhlování

lubo • 17.6. 12:03

Zaokrouhlování

JoKe • 14.6. 15:19

Zaokrouhlování

Mirek-Kraus • 14.6. 13:52