• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

Příspěvky uživatele

No veď vravím, že som to moc netestoval :) Zabudol som otočiť pole :( Vymenil som prílohu aj kód v prvom príspevku.

Ale otestujte si to, príliš pozornosti som tomu nevenoval
Sub Aktualizuj()
Dim colData As New Collection, D As Long, R As Long, arrZdroj(), arrData(), Pocet As Long

With wsData
D = .Cells(Rows.Count, 5).End(xlUp).Row - 3
If D = 1 Then Exit Sub
ReDim arrData(1 To D, 1 To 1)
If D = 1 Then arrData(1, 1) = .Cells(4, 5).Value Else arrData = .Cells(4, 5).Resize(D).Value
End With

On Error Resume Next
For R = 1 To D
colData.Add arrData(R, 1), CStr(arrData(R, 1))
Next R
On Error GoTo 0

With wsZdroj
R = .Cells(Rows.Count, 1).End(xlUp).Row - 1
If R = 1 Then Exit Sub
ReDim arrZdroj(1 To R, 1 To 1)
If R = 1 Then arrZdroj(1, 1) = .Cells(2, 1).Value Else arrZdroj = .Cells(2, 1).Resize(R).Value
End With

Erase arrData

On Error Resume Next
For R = 1 To R
colData.Add arrZdroj(R, 1), CStr(arrZdroj(R, 1))
If Err.Number <> 0 Then
Err.Clear
Else
Pocet = Pocet + 1
ReDim Preserve arrData(1 To 1, 1 To Pocet)
arrData(1, Pocet) = arrZdroj(R, 1)
End If
Next R
On Error GoTo 0

If Pocet > 0 Then wsData.Cells(D + 4, 5).Resize(Pocet).Value = Application.Transpose(arrData)
End Sub

Pretože "R" je v českom Exceli vyhradený formátovací znak pre rok (v SK/EN je to "Y"). Veď to dajte takto:
="VYR"&TEXT(B1;"###")
="VYR"&HODNOTA.NA.TEXT(B1;"###")
alebo
="VYR"&B1
alebo
="VYR"&TEXT(B1;"000")
="VYR"&HODNOTA.NA.TEXT(B1;"000")
záleží na tom, čo je v B1 a čo má byť presne výsledkom.

=IFERROR(VLOOKUP(LEFT(A2;1);List2!$E$1:$F$3;2;FALSE);"")
=IFERROR(SVYHLEDAT(ZLEVA(A2;1);List2!$E$1:$F$3;2;NEPRAVDA);"")

To je doplnok "Analytické nástroje". Čo všetko obsahuje sa mi nechce hľadať. Vypnite ho v nastaveniach, a uvidíte, či Vám bude niečo pri práci chýbať.

Tu máte ešte prípadne aj obojstrannú verziu. Teda listy si označenú oblasť odovzdávajú navzájom.

A dal ste tam aj Modul s globálnou premennou sBunka ?

No tak to Vám Smart Filter (Rýchly filter) ani objekt Tabuľka nepôjde.
Vám teda ide vlastne o čo?
- Potrebujete iba zo zdrojových dát nájsť 1 hodnotu za splnenia niekoľkých kritérií ? To spravíme maticovým vzorcom.
- Alebo potrebujete po zadaní nejakých kritérií niekam do buniek, niekde vedľa vypísať všetky riadky zdrojovej tabuľky, ktoré vyhovujú ? To robte Rozšíreným filtrom s vhodne umiestnenými parametrami (to sa robí manuálne).
- A čo tak použiť KT ? Veď tá sa dá zobraziť takmer rovnako ako zdroj (nie vždy), a môžete použiť jej filtre.

Priložte prílohu s príkladom.

No Rýchlym filtrom...

Nemôžete mu vkladať oblasť, ale už redukované pole:
=MODE(IF(SUBTOTAL(3;OFFSET(ref. stĺp;ROW(ref. stĺp)-2;;1))=1;stĺp hodnôt))
=MODE(KDYŽ(SUBTOTAL(3;POSUN(ref. stĺp;ŘÁDEK(ref. stĺp)-2;;1))=1;stĺp hodnôt))

Takzvaný "Definovaný názov":
Karta Vzorce - Správca názvov - Nové (napísať názov) - Odkaz na (napísať vzorec alebo oblasť)
V určitých prípadoch sa dá použiť aj dynamicky meniaci sa rozsah. Napr ak v názve POCTY zmeníte vzorec na
=OFFSET(Spolu!$B$3;;;COUNTA(Spolu!$B$3:$B$500))
=POSUN(Spolu!$B$3;;;POČET2(Spolu!$B$3:$B$500))
tak keď pripíšete nový údaj, tabuľky ho do seba zahrnú.
Ale slová "v určitých prípadoch" znamenajú napr.:
-musí sa jednať o súvislú oblasť bez prázdnych riadkov, inak funkcia COUNTA/POČET2 nebude vracať požadované číslo
-pod zdrojovou tabuľkou nesmú byť žiadne iné dáta
-výsledkové tabuľky musia byť dostatočne dimenzované na predpokladaný možný počet výsledkov
-rozumne veľká zdrojová oblasť - teraz je B3:B500. Určite nedávať celý stĺpec (milión riadkov).
...

No neviem, mňa napadá len takéto zložitejšie riešenie (nesedí nám spolu zaokrúhľovanie) :
=IF(B2<>"";B2;C1+(MIN($B3:$B$366)-MAX($B$1:$B2))/(MATCH(MIN($B3:$B$366);$B$1:$B$366;0)-MATCH(MAX($B$1:$B2);$B$1:$B2;0)))

=KDYŽ(B2<>"";B2;C1+(MIN($B3:$B$366)-MAX($B$1:$B2))/(POZVYHLEDAT(MIN($B3:$B$366);$B$1:$B$366;0)-POZVYHLEDAT(MAX($B$1:$B2);$B$1:$B2;0)))

No, bez Select-u:

hárok1
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
sBunka = Target.Address
End Sub

hárok2
Private Sub Worksheet_Activate()
On Error Resume Next
Range(sBunka).Activate
End Sub

Modul
Public sBunka As String

Kvázijednoduchý maticový vzorec ? Pridal som aj list s výberom z rozbaľovacieho zoznamu.

Zatiaľ len na 1 list. Na všetky listy v zošite, je potreba myslieť ešte na výpis listov, ktoré sa odomknúť nepodarilo (pže užívateľ v odomknutom stave mohol zmeniť heslo manuálne)... Neviem, či na to budem mať večer čas. Zatiaľ toto...
Sub Zamknout_Odemknout()
Dim sPass As String

With wsData
If .ProtectContents Then
sPass = InputBox("Heslo k odemknutí listu:", "Odemknout list")
If sPass = "" Then MsgBox "Nebylo zadáno žádné heslo." & vbNewLine & "List nebyl odemčen.", vbExclamation: Exit Sub

On Error Resume Next
.Unprotect Password:=sPass
If Err.Number <> 0 Then
MsgBox "Zadané heslo není správné!" & vbNewLine & "List nebyl odemčen.", vbCritical: Exit Sub
Else
.Shapes("btnLock").OLEFormat.Object.Caption = "Zamknout"
End If
On Error GoTo 0

Else

sPass = InputBox("Heslo k zamknutí listu:", "Zamknout list")
If sPass = "" Then MsgBox "Nebylo zadáno žádné heslo." & vbNewLine & "List nebyl zamčen.", vbExclamation: Exit Sub

If sPass <> InputBox("Zadejte heslo ještě jednou:", "Potvrdit heslo") Then
MsgBox "Zadaná hesla se neshodují!" & vbNewLine & "List nebyl zamčen.", vbCritical: Exit Sub
Else
.Shapes("btnLock").OLEFormat.Object.Caption = "Odemknout"

On Error Resume Next
.Protect Password:=sPass
If Err.Number <> 0 Then
MsgBox "Při zamykání listu nastala chyba!" & vbNewLine & "List nebyl odemčen.", vbCritical, "Chyba": Exit Sub
.Shapes("btnLock").OLEFormat.Object.Caption = "Zamknout"
End If
On Error GoTo 0
End If
End If
End With
End Sub

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse