Criteria1:="<>" - zobrazí všetky riadky, ktoré majú v danom stĺpci nejakú hodnotu
Criteria1:="" - zobrazí všetky riadky, ktoré nemajú v danom stĺpci žiadnu hodnotu
To "Criteria1:=XYZ" znamená, že XYZ je to, čo chcete mať zobrazené, nie to čo chcete mať skryté. Teda vo Vašom prípade použite
ActiveSheet.Range("$A$8:$AS$150").AutoFilter Field:=38, Criteria1:=""
Vy chcete nájsť riadok s hodnotou v stĺpci A, bez ohľadu na to, či je riadok skrytý alebo nie ?
Tak skúste MATCH
Dim r As Long
On Error Resume Next
r = WorksheetFunction.Match(10, Columns(1), 0)
If Err.Number <> 0 Then r = 0
On Error GoTo 0
a máte riadok. Namiesto toho "r = 0" si dajte vhodnú akciu pre prípad, že položku nenájde.
Myslíte Tool - Options - Editor Format - Font - Curier New (Stredoeurópske) ?
Ja keď to mením napr. na Západné, tak mi akurát v makre napr. z Ř urobí Fí alebo z ľ urobí 3/4, ale odkaz na objekt listu funguje normálne. Každopádne by som odporúčal tie názvy nahradiť, a ak ich máte rozumne nazvané (bez kolízie názvov s inými časťami názvov) tak aj hromadne : Ctrl+F - Replace - Current Project - Direction - All
Find What - názov s diakritikou
Replace With - názov bez diakritiky
Variant 1:
-Zistíme počet buniek ktoré spĺňajú to že v C10:C22 je hodnota z F a zároveň v D10:D22 je hodnota "ano".
-Ak je viac ako 0, napíš "ano".
-Inak zistíme počet buniek ktoré spĺňajú to že v C10:C22 je hodnota z F a zároveň v D10:D22 je hodnota "ne".
-Ak je viac ako 0, napíš "ne".
-Inak nenapíš nič (prípad prázdnej bunky v D10:D22 aj keď hodnota v C10:C22 sedí, alebo prípad ak nič nesedí).
Variant 2 (maticový vzorec Ctrl+Shift+Enter):
-Ak je v C10:C22 hodnota z F, odlož jej poradové číslo.
IF($C$10:$C$22=F10;ROW($C$10:$C$22)-9)
KDYŽ($C$10:$C$22=F10;ŘÁDEK($C$10:$C$22)-9)
To $C$10:$C$22=F10 vráti pole obsahujúce buď TRUE/PRAVDA alebo FALSE/NEPRAVDA pre každú položku.
To ROW($C$10:$C$22)-9 vráti pole poradových čísel {1;2;3;4;5...}. A tam kde bolo TRUE/PRAVDA za zachová toto číslo.
-Teraz zistíme ktoré číslo riadku v danej oblasti je posledné. Pomocou LARGE(pole čísel, číslo pozície):
LARGE(IF($C$10:$C$22=F10;ROW($C$10:$C$22)-9);1)
LARGE(KDYŽ($C$10:$C$22=F10;ŘÁDEK($C$10:$C$22)-9);1)
-No a prečítame si poslednú hodnotu z tých, ktoré spĺňajú podmienku, keď už vieme jej číslo:
INDEX($D$10:$D$22;LARGE(IF($C$10:$C$22=F10;ROW($C$10:$C$22)-9);1))
INDEX($D$10:$D$22;LARGE(KDYŽ($C$10:$C$22=F10;ŘÁDEK($C$10:$C$22)-9);1))
-Ďalej ošetríme chybu
IFERROR(INDEX($D$10:$D$22;LARGE(IF($C$10:$C$22=F10;ROW($C$10:$C$22)-9);1));"")
IFERROR(INDEX($D$10:$D$22;LARGE(KDYŽ($C$10:$C$22=F10;ŘÁDEK($C$10:$C$22)-9);1));"")
-No a na záver je už iba zbytočný REPT
=REPT(IFERROR(INDEX($D$10:$D$22;LARGE(IF($C$10:$C$22=F10;ROW($C$10:$C$22)-9);1));"");1)
=OPAKOVAT(IFERROR(INDEX($D$10:$D$22;LARGE(KDYŽ($C$10:$C$22=F10;ŘÁDEK($C$10:$C$22)-9);1));"");1)
Ten REPT/OPAKOVAT je tam len preto nech nevznikne možno neželaná hodnota 0. Ale to by ste mohol radšej cez vlastný formát odstrániť.
Proste podľa toho čo potrebujete a podľa toho aké majú byť výsledky sa potom ešte toto upravuje.
Odkrokujte si tie vzorce vo Vzorce - Kontrola vzorce - Vyhodnotiť vzorec, a uvidíte čo to robí. Vráti to poslednú položku z D10:D22, nech je akákoľvek.
2 návrhy. Uvidím, či prídete na to aký je medzi nimi zásadný rozdiel ...
Musíte sa zaregistrovať, aby ste mohol prikladať prílohy (.xlsm musíte zazipovať, ostatné rovno vložiť).
?
=IF(COUNTIFS(G$2:G2;G2;F$2:F2;F2)=1;SUMIFS(D:D;G:G;G2;F:F;F2);"")
=KDYŽ(COUNTIFS(G$2:G2;G2;F$2:F2;F2)=1;SUMIFS(D:D;G:G;G2;F:F;F2);"")
Vy stále píšete že chcete v matke "spúšťať makro v otvorených zošitoch". To je úplne zlý popis. Vy chcete spúšťať matkine makro nad otvorenými zošitmi. To je niečo úplne iné. To čo voláte teraz je "makrobla", ktorý v tých otváraných súboroch nieje. Tam je "makro26".
Čo chcete teda robiť ?
Namiesto xlApp.Run... použite:
Call Vykonavacie_makro(xlApp.ActiveWorkbook)
A na konci procedúry "nejmakro" zabúdate zrušiť inštanciu (čo na to správca procesov vo Win ? Koľko tam máte Excelov pri ladení ?).
xlApp.Quit
Set xlApp = Nothing
Vykonávacie makro, umiestnené v matke:
Sub Vykonavacie_makro(WB As Workbook)
'POZOR ! Do A1 napíše "Halóó" !
'Sem vložte požadované operácie nad otvorenými zošitmi,
'ale POZOR (!) vždy sa na zošit odkazujte cez premennú WB,
'ktorá teraz obsahuje zošiť z xlApp.
WB.Worksheets(1).Cells(1, 1).Value2 = "Halóó"
End Sub
Ak myslíte "vidieť" ako v zozname dostupných makier pri priraďovaní napr. tlačítku, tak tam to predpokladám nebude z jednoduchého dôvodu - je to iná inštancia Excelu. Teda samostatne spustený program, ktorý nemá z inými nič spoločné. Môžete k makrám pristupovať iba cez premennú xlApp, čo je odkaz na tú druhú inštanciu Excelu. Nemám čas to skúšať, je to len domnienka.
Vpravo som Vám pre kontrolu dal aj celé poradie. Niektoré stĺpce by sa dali porušiť, podľa toho, aké informácie požadujete mať zobrazené (rozhodujúce body, 2x celkové body, 2x meno, a pod...)
To na pridanie riadku Enterom nestačí. Na to je treba ešte nastaviť EnterKeyBehavior = True. A automatické "riadkovanie", teda odsúvanie slov na ďalší riadok rieši WordWrap = True.
A prečo to musí byť také komplikované ? Veď si iba niekde ukladajte číslo riadku na ktorý ste klikol (teraz som to dal v liste "B1" do bunky A2), a v liste "C1" sa Vám to naindexuje samé vzorcom.
EDIT: A to som nespomenul, možnosť urobiť to výberovým zoznamom, bez makra, ale to už nestíham, možno večer ak bude treba.
Súbor - Možnosti - Rozšírené - Zobraziť možnosti pre tento hárok - Zobraziť zlomy strán.
alebo potom makrom
ActiveSheet.DisplayPageBreaks = False
Sub BARVA()
Dim RNG As Range, Oblast As Range, Riadkov As Long
Set Oblast = ActiveSheet.Range("A19:A38")
On Error Resume Next
Set RNG = Oblast.SpecialCells(xlCellTypeVisible)
Riadkov = RNG.Cells.Count
If RNG Is Nothing Or Riadkov <> Oblast.Cells.Count Then
If MsgBox("Pro zapnutí makra je nutné zrušit všechny filtry." & vbNewLine & "Chcete zrušit filtr?", vbExclamation + vbYesNo) = vbNo Then GoTo KONIEC
ActiveSheet.ShowAllData
End If
On Error GoTo 0
With Oblast.Resize(, 21).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
KONIEC:
Set Oblast = Nothing: Set RNG = Nothing
End Sub
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
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.