Nemá to byť, čiste náhodou, ešte v kombinácii so Shift? T.j:
CTRL+SHIFT+1
CTRL+SHIFT+2
CTRL+SHIFT+3
atd.
Mám za to, že si nedávno písal, že nejaké makrá distribuješ po vašej firme, ale mne do toho vlastne nič nie je. Čo sa týka kurzu, tak sa domnievam, že kniha za pár stoviek ti dá viac, než dvojdňový kurz za niekoľko tisíc. Čo sa tak asi dá naučiť za dva dni. Nikdy som žiadny kurz na programovanie neabsolvoval. Ale u niekoho to môže fungovať inak.
Pokiaľ by som sa narodil ešte raz, tak by som sám rád vyštudoval programovanie, žiadne oficiálne vzdelanie v tomto smere ani ja nemám.
Chce to hlavne skúšať v prvom rade sám, dotazy vznášať až v momente, keď je jeden skutočne v koncoch a odpoveď nenájde ani po intenzívnej snahe a hľadaní riešenia trebárs na internete.
Existuje vhodná alternatíva priamo vo VBA - textová funkcia Replace; takže WorksheetFunction.Substitute je pmn v tomto prípade zbytočne zdĺhavá cesta.
Príloha nič moc, vychádzal som z makra, ktoré si sa tam snažil vytvoriť. Pre ilustráciu som nechal zakomentované pôvodné inštrukcie a pridal nové, o ktorých iba hádam, že by mali robiť snáď niečo, čo si zamýšľal, ale nie si schopný to ani zrozumiteľne v zadaní popísať.Private Sub Worksheet_Activate()
'tu je tvoj povodny kod
'For i = 1 To 10
' For j = 2 To 20
' For k = 3 To 30
'
' If Cells(2, 2) <> 0 Then
' Cells(2, 8) = Application.WorksheetFunction.Substitute(Cells(2, 2), " - ", "") & ";" & Cells(2, 1) & ";" & Application.WorksheetFunction.Substitute(Cells(1, 2), "1", "")
' Else
' Cells(2, 8) = ""
' End If
'
' Next k
' Next j
'Next i
'tu je snad funkcna modifikacia hore uvedeneho
For i = 2 To 4 'pomocna premenna pre stlpec
For j = 2 To 6 'pomocna premenna pre riadok
' For k = 3 To 30
If Cells(j, i) <> 0 Then
Cells(j, i + 6) = Application.WorksheetFunction.Substitute(Cells(j, i), " - ", "") & ";" & IIf(Cells(j, 1) = "", Cells(j - 1, 1), Cells(j, 1)) & ";" & Application.WorksheetFunction.Substitute(Cells(1, i), i - 1, "")
Else
Cells(j, i + 6) = ""
End If
' Next k
Next j
Next i
End Sub Riadok Cells(j, i + 6) = Application.WorksheetFunction.Substitute(Cells(j, i), " - ", "") & ";" & IIf(Cells(j, 1) = "", Cells(j - 1, 1), Cells(j, 1)) & ";" & Application.WorksheetFunction.Substitute(Cells(1, i), i - 1, "") by sa dal napísať i takto:Cells(j, i + 6) = Replace(Cells(j, i), " - ", "") & ";" & Cells((Int(j / 3) + (j Mod 3 = 0)) * 3 + 2, 1) & ";" & Replace(Cells(1, i), i - 1, "")Ty fakt tvoríš makrá v práci i pre kolegov? Neuveriteľné.
http://lmgtfy.com/?q=data+validation+autocomplete
P.S. Tých 6.000 riadkov v jednej bunke vskutku nemáte, to sa pletiete
No, zdržím sa radšej komentára...
Odstráň z kódu prázdne riadky, konkrétne riadok medzi
If Wks.Name = cell.Parent.Name And _
a
strAdr = Application.Caller.Address Then
Ďalej medzi
'zabránení cyklického odkazu tj. jesli kontrolovaná bunka _
a
není ta, která obsahuje funkci. V takovém prípade je vynechána
Kontrolná otázka: tušíš, k čomu slúži znak "_", ktorému predchádza medzera (na konci riadku)? Ani omylom, viď? No nič, VBA rozumieť nepotrebuješ, nie je to povinnosť
VBA nie je potrebné
Pokiaľ funguje tebou uvedená funkcia SumaPresListy, tak nevidím dôvod, prečo by nemali fungovať MaxPresListy a MinPresListy. Ani jeden nie je žiadny vrchol programátorského umenia, ty však nepotrebuješ kódu rozumieť, takže to je vlastne jedno, páč funkčné to je. Byť tebou, tak sa najprv pozriem na 3D vzorce.
Nejde o to, že by si nejako špatne požiadal o pomoc. Problém je, že ja som síce ochotný ti pomôcť, ale úroveň našich znalostí je bohužiaľ niekde inde, takže si logicky nemôžeme rozumieť. Ja chybne predpokladám, že máš nejaké znalosti, ktoré evidentne nemáš, takže tu máme akýsi missing link (keď budem chcieť komunikovať s niekým o oblasti, o ktorej viem tušku, budem na tom podobne). Samozrejme, som potom rozčarovaný, keď napriek mojej snahe pomôcť toto končí akurát konštatovaním, že to nefunguje. Ja nemám talent na vysvetľovanie a tebe chýba znalosť.
Pokiaľ ti teda funguje aspoň to od Dinga (opakujem, je to zjednodušenie môjho riešenia), tak pokračuj v tom, čo pre teba pripravil Dingo. Hyperlinky buď odstráň, alebo do stĺpca vedľa zadaj vzorec, ktorý sa bude odkazovať na bunku vľavo. Worksheet_SelectionChange event potom aplikuj na tieto nové bunky. Kliknutím na hyperlink sa totiž otvorí Windows Explorer, ako si sám zistil, takže to musíš obísť (tým, že budeš klikať do bunky, v ktorej hyperlink nie je). Príklady na Worksheet_SelectionChange event si vygoogluješ a upravíš na svoj rozsah buniek. Môžeš žiadať o riešenie/pomoc, ale nepočítaj s tým, že pochopíš niečo za 5 minút, pokiaľ to vyžaduje mesiace štúdia (v lepšom prípade).
Dingo len zjednodušil môj postup; to, že ti to nefunguje, je spôsobené nepochopením môjho kódu (viacmenej). K hyperlinkom - existuje dôvod prečo ich nemôžeš odstrániť / prečo na liste musia byť?
a pokud ano,pak se musí definovat konkrétní buňky ve vba - len na tomto fóre bolo uvedených bezpočet príkladov, ako udalosť Worksheet_SelectionChange aplikovať na konkrétny rozsah buniek.
Problém je v tom, že sa púšťaš (podobne ako mnoho ďalších tázateľov z poslednej doby) do vecí, k riešeniu ktorých vám chýbajú základné znalosti. Takže ste potom frustrovaní z toho, že "to nefunguje". Ste v tom totiž úplne stratení a trpíte romantickou predstavou, že skopírovanie nejakého kódu zaručí funkčnosť riešenia úlohy, s ktorou sa trápite. Začínajúceho lyžiara by asi pri troche zdravého rozumu nenapadlo hneď prvý deň sa nechať vyviezť lanovkou na Mont Blanc, v otázke VBA sa pmn pár tunajších ľudí o niečo podobné snaží
o.k., pokiaľ vedome žiadaš po niekom medvediu službu, tvoja vec, nemám s tým problém:Function MinPresListy(cell)
Dim dblVal
Dim strAdr As String
Dim Wks As Object
Application.Volatile
strAdr = cell.Range("A1").Address
dblVal = "neexistuje"
For Each Wks In cell.Parent.Parent.Worksheets
If Wks.Name = cell.Parent.Name And _
strAdr = Application.Caller.Address Then
'zabránìní cyklického odkazu tj. jesli kontrolovaná buòka _
není ta, která obsahuje funkci. V takovém pøípadì je vynechána
Else
If WorksheetFunction.IsNumber(Wks.Range(strAdr)) Then
If Wks.Range(strAdr) < dblVal Then dblVal = Wks.Range(strAdr)
End If
End If
Next Wks
MinPresListy = dblVal
End Function
Function MaxPresListy(cell)
Dim dblVal
Dim strAdr As String
Dim Wks As Object
Application.Volatile
strAdr = cell.Range("A1").Address
dblVal = "neexistuje"
For Each Wks In cell.Parent.Parent.Worksheets
If Wks.Name = cell.Parent.Name And _
strAdr = Application.Caller.Address Then
'zabránení cyklického odkazu tj. jesli kontrolovaná bunka _
není ta, která obsahuje funkci. V takovém prípade je vynechána
Else
If WorksheetFunction.IsNumber(Wks.Range(strAdr)) Then
If dblVal = "neexistuje" Then
dblVal = Wks.Range(strAdr)
ElseIf Wks.Range(strAdr) > dblVal Then dblVal = Wks.Range(strAdr)
End If
End If
End If
Next Wks
MaxPresListy = dblVal
End FunctionJedná sa o primitívnu modifikáciu tebou niekde získaného kódu (nič moc), tých 5 minút svojho času ti venovať môžem, viac po mne nežiadaj.
Dovolím si otázku: K čomu ti je kód, ktorý nechápeš?
3D vzorec ti nehovorí nič, čo teda skúsiť: http://lmgtfy.com/?q=3D+formulas+excel
Isteže ide. Pokiaľ porozumieš kódu, ktorý si sem nakopíroval, tak si ho dokážeš i modifikovať tak, aby miesto sumy vracal maximum.
Neviem ale, z akého dôvodu je nutné programovať užívateľskú funkciu tam, kde úplne postačuje jednoduchý 3D vzorec.
Revize -> Zmeny -> Sledovanie zmien. Nejaké zmeny to zachytí, ale stopercentné to pmn nie je. Nepoužívam to. Inou možnosťou je naprogramovať si vypisovanie všetkých zmien do logu. Pokiaľ je súbor niekde na zdieľanom disku, tak je možné nastaviť zálohovanie postupne vznikajúcich verzií. Možnosti teda nejaké sú, ale nie je to úplne bez námahy a nie vždy to musí fungovať spoľahlivo.
http://xl-central.com/lookup-single-criteria-multiple-sheets.html Maticový vzorec na tej stránke dole je šikovný.
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.