Příspěvky uživatele
< návrat zpět
Včera som našiel niečo od Bruin-a (odkaz už nemám som teraz na tablete) ale rovnako som to nerozchodil. V Delphi som kedysi takúto featurku urobil oveľa ľahšie. Škoda.
No, mám toho veľa, ale tak chodím sem relaxovať, tak snáď sa bude dať. Každopádne, načítať množstvo dát z iných zošitov je násobne zložitejšie ako z rovnakého zošitu. To makro bude musieť vedieť aké mená listov má hľadať dopredu. Cez ExecuteEcxel4Makro checkneme či sa list nachádza v zošite, takže budeme vedieť už aj súbor aj list, vložíme teda vzorce na dolovanie dát. Ale ten menný zoznam musí byť dopredu známy. Nebudem to vysvetľovať celé, keď prídem domov a bude čas mrknem Vám na to.
Aby Vám to ignorovalo len jeden list tak tam je
If .Name <> "Spolu" Then
ale aby Vám to ignorovalo viac listov, treba ten riadok zmeniť na
If IsError(Application.Match(.Name, Array("Spolu", "Ďalší"), 0)) Then
Pričom do toho poľa Array("Spolu", "Ďalší")
pripíšete rovnakým spôsobom všetky, ktoré má ignorovať.
Všetky ostatné listy sú považované za dátové.
Urobil som Vám zatiaľ obe verzie.
Na liste 1 máte mesačný, mesiac meníte iba zadaním dátumu prvého dňa mesiaca v A2, regulárne dni mesiaca sa dopočítajú samé. Obdobie zadávate v číselnom formáte v H2 a I2.
Na liste 2 máte "nekonečnú" verziu, kde sú dynamické rozsahy a tabuľka je prevedená na ExcelTable, a po napísaní mien do B alebo C sa pridá automaticky riadok aj so vzorcami. Obdobie zadávate v dátumovom formáte v H2 a I2. Ak nebudete túto verziu používať, zmažte tento list aj Definované oblasti "Datum" a "Stanoviste".
Mám to pre Vás, len mi ešte upresnite, či ide o napr. jeden mesiac, alebo či bude pod sebou dlhšie prelínajúce sa obdobie.
- To tam bude iba 12 dní ? Asi celý mesiac nie ?
- A čo keď bude mať niekto PN alebo dovču ?
- Odkiaľ sa zoberú tie prvé 2 zmeny (posledná a predposledná zmena) ?
- Bude tam viac riadkov (zamestnancov) ? Ak áno, aký vzťah bude medzi zmenami týchto zamestnancov ?
Veľmi dobre napísané, že Excel nieje zabezpečená DB, ale má iba prvostupňovú ochranu proti zmene "omylom". Je to tabuľkpvý procesor.
Do nekonečna to nieje. Najskôr sa prehľadá stĺpec A na slovo "KEJE:", ak ho nájde, skontroluje, či v bloku "KEJE:" je hľadaná farba, ak nie, hľadá ďalej, s posunutou hodnotou poz, ktorá označuje počiatok hľadania (inak by hľadal od začiatku). Na tom mojom súbore je KEJE 2x. čiže cyklus while prebehne 3x. Prvý krát najde prvú KEJE, druhý krát druhé KEJE, tretí cyklus až po koniec KEJE nenájde a skočí na KONIEC. Toto isté sa opakuje celé ešte raz ale s hodnotou "Fabrics:". Ak nájde v bloku KEJE alebo Fabrics zhodu farby, tak vyhľadá kde sa pod blokom nachádza "Hmax" a potom nájde prvú prázdnu bunku pod Hmax, takto zistí umiestnenie tabuľkového bloku dát. Ešte ho rozšíri o počet stĺpcov v riadku Hmax, ale o to nejde. To je stručný popis toho ako funguje tá druhá časť.
Ak chcete pošlite mi Váš konkrétny reálny súbor na mail (v profile).
Žiaľ Vami popisovaný problém sa mi nedarí nasimulovať. U mňa (Excel 2013 x64) to funguje tak ako píšete, že by malo. Teda ak nenájde farbu na liste KEJEFabrics, nič sa nedeje, ostáva zobrazená aspoň tabuľka z listu Stav.
Otvorte si VBA (ľavý Alt+F11), tam si v Module1 nastavte kurzor niekde do procedúry Sub Hledat(), a stláčajte F8, týmto budete krokovať makro a jeho priebeh. Uvidíme, či kde Vám to havaruje. Dajte vedieť riadok na ktorom to kľaklo. Samozrejme pri krokovaní použite rovnaké hodnoty ako keď Vám to spadlo.
Spravil som Vám makro, ktoré vyhľadá a vypíše hľadané tabuľky na list Hledat. Odtiaľ si to už vytlačte.
Ja som to raz urobil tak, že makrá boli zaheslované v zošite bol visible po štarte iba jeden list s logom nič viac. Pracovné listy boli VeryHidden. Ak užívateľ súbor otvoril, videl len logo, ale keď klikol na Povoliť makro, nabehlo OnOpen a zviditeľnilo pracovné listy a list logo dalo VeryHidden. Pred uložením v BeforeSave sa opäť zviditeľnilo logo a listy zneviditeľnili, uložilo sa to a opät sa zviditeľnili listy, nastavil sa príznak uloženia. Takže pri ďalšom otvorení bolo opäť iba logo. Neviem či som to riešil dobre, ale bolo to pre dané potreby dostatočné.
Polovičku otázky nechápem. Nahradenie VLOOKUP je mnohonásobná vec, kdežto výpis vyhľadanej hodnoty na iný list je jednorázová vec.
Tu máte makro, ktoré prehľadá celú zvolenú oblasť (nastavíte pomocou konštánt) v Hárok1 a vypíše celý riadok s nájdenou hodnotou na prvý voľný riadok v liste Zhoda.
Dodajte prílohu s lepším popisom a bude sa tvoriť ľahšie.
Inak samotné vyvolanie natívneho okna Find:
Application.CommandBars.FindControl(ID:=1849).Execute
alebo
Application.Dialogs(xlDialogFormulaFind).Show
ale použiť ich programovo na hľadanie a vracanie výsledku neviem.
EDIT: Alebo použite túto UDF funkciu:
Function FULLLOOKUP(Co As Variant, Kde As Range, Stlpec As Integer) As Variant
Dim r As Long
On Error Resume Next 'Hľadanie hodnoty
r = Kde.Find(What:=Co, LookIn:=xlValues, LookAt:=xlPart, searchorder:=xlByRows, searchdirection:=xlNext, MatchCase:=False).Row
On Error GoTo 0 'Vrátenie odchytenia chyby
If r = 0 Then FULLLOOKUP = CVErr(xlErrNA) Else FULLLOOKUP = Kde.Parent.Cells(r, Stlpec).Value 'Vráť hodnotu zo zadaného stĺpca v najdenom riadku
End Function
=PROPER(B36)
Určite na to potrebujete makro ? Tu máte vzorec, keď prídem urobím Vám aj to makro.
EDIT:
Makro, ak tomu nebudete rozumieť, rozsekám Vám to na drobné :
Sub Tlačidlo1_Kliknúť()
With Worksheets("H")
If Not IsError(Application.Match(.Cells(3, 3).Value, Worksheets("H2").Columns(WorksheetFunction.Match(.Cells(2, 3).Value, Worksheets("H2").Cells(1, 1).Resize(1, 6).Value, 0)), 0)) Then MsgBox ("Číslo sa nachádza v zadanej oblasti.")
End With
End Sub
Toto Vám bude brať v úvahu iba zvolenú oblasť, nastavíte si veľkosť písma pre väčšiu, menšiu a rovnú hodnotu, vysporiada sa to aj s kopírovaním viac buniek naraz (aj cez hranicu oblasti), ignoruje "" a text, mení všetko naraz.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oblast As Range, Bunka As Range, ZmenitV As Range, ZmenitM As Range, ZmenitN As Range
Const VACSIE = 12
Const MENSIE = 8
Const ROVNE = 10
Const HRANICA = 10
Set Oblast = Range("A1:C10")
On Error Resume Next
For Each Bunka In Target
If Union(Oblast, Bunka).Address = Oblast.Address And Bunka <> "" And IsNumeric(Bunka) Then
Select Case True
Case Bunka.Value > HRANICA: If ZmenitV Is Nothing Then Set ZmenitV = Bunka Else Set ZmenitV = Union(ZmenitV, Bunka)
Case Bunka.Value < HRANICA: If ZmenitM Is Nothing Then Set ZmenitM = Bunka Else Set ZmenitM = Union(ZmenitM, Bunka)
Case Bunka.Value = HRANICA: If ZmenitN Is Nothing Then Set ZmenitN = Bunka Else Set ZmenitN = Union(ZmenitN, Bunka)
End Select
End If
Next Bunka
ZmenitV.Font.Size = VACSIE
ZmenitM.Font.Size = MENSIE
ZmenitN.Font.Size = ROVNE
On Error GoTo 0
End Sub
Uživatelské menu
\nMenu
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.
RSS nejnovější články