Příspěvky uživatele
< návrat zpět
Keď nemám žiadnu prílohu, žiadne dáta ako príklad, žiadny podrobnejší popis (súbory sú/niesú na sieti...), tak fakt neviem. Je to už môj starý kód, dnes by som robil niektoré veci inak. Ale ako ho skúšam - funguje. Takže ... ?
A takto "blbě" cez PF+normálny F by to nešlo ?
Tak skúste :
Range("H:H").SpecialCells(xlCellTypeBlanks).Cells(1).Select
resp. takto, ak to má začínať až od H2 (ak H1 nemá byť náhodou zahrnutá):
Range("H2:H" & Rows.Count).SpecialCells(xlCellTypeBlanks).Cells(1).Select
Napr.:
=IFERROR(INDEX($C$4:$C$13;COUNTIF($B$4:$B$13;"<"&H4)+1);0)
=CHYBHODN(INDEX($C$4:$C$13;COUNTIF($B$4:$B$13;"<"&H4)+1);0)
S Vašimi bodovými hodnotami čo tam máte, to ale nesedí. Tie Vaše hodnoty nespĺňajú podmienky, alebo som ich nepochopil správne. Ja to chápem tak, že časy v B sú "do, vrátane".
Prečo chcete silou-mocou použiť xlDown ? Použite xlUp. Toto funguje na Vašom súbore na každom jednom liste:
Sub PrvyVolny()
Cells(Rows.Count, 8).End(xlUp).Offset(1).Select
End Sub
Šmarjá 
To máte tisíce riadkov kódu, ktorý je neskutočne pomalý, zbytočne sa dookola opakujúci, neflexibilný (nieje možné zmeniť názvy listov len tak jednoducho), a strašne neprehľadný.
To treba zjednodušiť.
Napr 2 bloky "' ODKOVENÍ PŘÍČEK" a "' VLOŽ SLOUPCE SE STŘEDISKEM"
sa dajú zjednodušiť napr. na :
Dim SH As Worksheet
For Each SH In Worksheets
Application.Goto SH.Cells(2, 1)
ActiveWindow.FreezePanes = False
Cells.FormatConditions.Delete
Columns("D:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(1, 4) = "STŘ"
Next SH
Blok "' USPOŘÁDÁNÍ SLOUPCŮ" by stačil pravdepodobne napr takto nejako:
Columns("J:J").Delete Shift:=xlToLeft
Columns("T:T").Cut
Columns("A:A").Insert Shift:=xlToRight
Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B1") = "Poznámky"
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C1") = "Stroj"
Columns("E:E").Cut
Columns("H:H").Insert Shift:=xlToRight
Range(Range("A1"), Range("A1").End(xlToRight)).AutoFilter
Union(Columns("K:K"), Columns("M:P"), Columns("R:R")).Replace What:=".", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
With AutoFilter.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("D1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
To dávam vlastne zbrucha, otestujte, a skúste sa pohrať z povynechávaním neustálych zbytočných Select-ov, a hlavne neopakovaním rovnakého kódu pre všetky listy. Napr. použitím cyklu, alebo poľa a procedúr s parametrom, ...
Nemám na to čas, ale aj keby som mal, tak by som musel mať echt náladu rozobrať funkčnosť 2500 riadkov, tipnúť si účel, spôsob, prekopať, zjednodušiť, vyskúšať...
Ja Vám rozumiem, že ste makro nahral, a funguje, ale musí byť veľmi pomalé. Nedávno tu bol postnutý ešte väčší kód cca 4500 riadkov. Takže rekordérom nieste Skúste niečo s tým urobiť, možno keď bude niekto vidieť Vašu urputnú snahu, tak sa Vám na to dá.
Inak ak chcete vynechať nejakú časť kódu v takom stave v akom to máte, tak pred inkriminovanou časťou urobte potrebnú kontrolu a za inkriminovanú časť vložte skok. Teda príklad:
If Range("A3")="" Then GoTo POKRACUJ1 'Skok na miesto s názvom POKRACUJ1
...
inkriminovaný kód
...
POKRACUJ1:
Bude pokračovať ďalej...
My ale netušíme, ako to u Vás vyzerá, čo robíte makrom, kde, za akých podmienok, či máte listy vytvorené, alebo ich vytvárate, z ktorého listu čítate tú hodnotu A3, či z riadiaceho alebo z výsledného (v ktorom má makro niečo robiť), ........
Každopádne spustiť či nespustiť makro sa dá jednoducho jedinou podmienkou If.
If Worksheets("XYZ").Cells(3, 1)<>"" Then Call MojeMakro
Ale fakt nevieme, či do makra má vstupovať nejaký parameter, napr. list, keď spomínate, že chcete vynechať nejaký list, alebo či prechádzate pomocou For-Each-Next všetky listy, alebo ...
S čím máte konkrétne problém ??? Tu máte nejaké príklady, a jedno konkrétne použitie s objektami Tabuliek na Vašom súbore. Objekt Tabuľka (nie obyč. tabuľka) som použil preto, lebo si myslím, že budete chcieť aby si to vzorec do ďalšieho riadku dopĺňalo samé.
Tak
Tak ?
pravý klik - Hypertextové prepojenie - Miesto v tomto dokumente - v spodnej časti vyberte list, a vo vrchnej zobrazovaný názov - OK.
Alebo maličké makro na prepínače v skupine.
Ako použiť makro? Priradiť ho k tlačítku. Neviem či je to to čo ste chcel. Išiel som podľa popisu, ale nepozdáva sa mi. Xlnc-emu to vysvetlite lepšie, lebo je to také "magické"... Držím palec.
???
To chcete takéto niečo ?
Sub Kopiruj_Click()
Dim SH As Worksheet, Stlpec As Integer, Meno As String
On Error Resume Next
For Each SH In Worksheets
With SH
Meno = .Name
If InStr(1, Meno, "FINAL") > 0 And Meno <> "FINAL" Then
Stlpec = WorksheetFunction.Match(CDbl(Date), .Rows(9), 0)
If Err = 0 Then
With .Cells(9, Stlpec).Resize(.Cells(Rows.Count, Stlpec).End(xlUp).Row - 8)
.Value = .Value
End With
Else
Err.Clear
End If
End If
End With
Next SH
End Sub
Lebo to je zlé riešenie. Čím neskorší produkt, tým viac kontrol bunky E3,a pri každej sa prestupuje z makra do listu (najpomalšia vec).
Čiže na začiatku testov si do premennej uložte hodnotu bunky E3. a testujte premennú.
ALE.
Lepšie bude, ak nebudete testovať po jednom produkte, ale dáte vyhľadať Application.Match alebo WorksheetFunction.Match tú hodnotu bunky v zozname produktov (ten predsa musíte mať, keď ho máte načítaný v bunke E3), a získate index produktu voči zoznamu. Tento index môžete použiť ako parameter procedúry, v ktorej sa bude makro vetviť podľa produktov napr. v konštrukcii Select Case.
Možností bude viacej, ale takýto popis je na riešenie absolútne nedostatočný. Pridajte podstatne viac informácií, počet produktov, počet je ne/menný, makro má každý produkt rovnaké, alebo iné. Je vôbec makro potrebné ? Ak napr. iba načítate z inej tabuľky údaje, dá sa to vzorcami. V príklade voláte rovnaké makro pre oba uvedené produkty .... atď.
Najlepšie urobíte, ak vložíte prílohu.
Skúste trošku pozmeniť makrá na :
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name = "Zoznam" Then Exit Sub
If Intersect(Target, Range("G5:AI53")) Is Nothing Then Exit Sub
With Target
Call PopisZmeny(Sh.Name, .Address(0, 0), .Value)
End With
End Sub
a
Sub PopisZmeny(List As String, Poloha As String, Napln As Variant)
Dim User As String
With Application
.EnableEvents = False
User = .UserName
With Sheets("Zoznam")
.Cells(.Cells(1, 7) + 1, 1).Resize(, 5) = Array(Now, List, Poloha, Napln, User)
End With
.EnableEvents = True
End With
End Sub
či sa to nezlepší. Mám tu jeden obdobný problém. Excel pri viac listoch takmer exponenciálne spomaľuje. Aj pri zadávaní údajov, ale najmä pri pridávaní nových listov. Žiaľ som rovnako bezradný. Skúste.
Uživatelské menu
\nMenu
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.
RSS nejnovější články