Příspěvky uživatele
< návrat zpět
Myslíte obyčajné tlačítko na liste ?
Sub Doplnit()
ActiveCell.Value = "Nejaký text"
End Sub
Bez problémov :
Sub Michal()
Hárok7.Range("A1").Value = "Michal"
End Sub
Sub Lýdia()
Hárok7.Range("A1").Value = "Lýdia"
End Sub
Sub Anna()
Hárok7.Range("A1").Value = "Anna"
End Sub
Ale keď má byť skrytý, a zároveň do neho chcete vpisovať filtrované meno, aby sa vyvolala akcia, tak to nemusí ten list vôbec existovať a použite takéto niečo :
Sub Michal()
Call Filtruj("Michal")
End Sub
Sub Lýdia()
Call Filtruj("Lýdia")
End Sub
Sub Anna()
Call Filtruj("Anna")
End Sub
Sub Vsetko()
Call Filtruj("")
End Sub
Sub Filtruj(S As String)
If S = "" Then
Sheets("Výpožičky").ShowAllData
Else
Sheets("Výpožičky").Columns("F:F").AutoFilter Field:=6, Criteria1:=S
End If
End Sub
Pavlus, on nepotrebuje ale zistiť v KT jedinečné záznamy (alebo počet jedinečných záznamov) z jedného stĺpca ničím nepodmienené. Ale podmienkou jedinečnosti je jeden jedinečný záznam z prvého stĺpca a v ďalšom stĺpci sa zisťuje počet jedinečných záznamov druhého stĺpca podmienených prvých stĺpcom. A to je niečo iné ako linky čo hneď hodí G na Lasákovic klučinu a pod.
Ten DataModel vyzerá sľubne, testol som to, len snáď si to do budúcna aj zapamätám.
Jeden pomocný stĺp byť nemôže ?
Neviem či rozumiem popisu problému, ale zmenil som všetky vzorce, a nemal by byť problém s kladným ani záporným výpočtom rozdielu ani priemeru, ani s výpisom " dní,". Uviedol som 2 verzie, jedna maticová - nepotrebuje pomocný stĺpec, a jedna nematicová - potrebuje pomocný stĺpec. Vzorce vyzerajú zložito, ale to len kvôli tomu, že sa v nich počíta všetko X krát, kvôli znamienku "-", kvôli textu " dní, ", kvôli zvyšku ... Ale nebojte sa výpočet pár takých matíc si 10 ročné PC ani nevšimne :)
Ak som netrafil čo chcete, nepopisujte problém textom, ale zvýraznite bunky v príklade s popisom v prílohe.
To je jednoduché, máte tam 10000 riadkov, ktoré boli nejako použité, a následne iba vymazané. Keď ich vymažete iba pomocou Delete, tak ostanú označené ako "použitá oblasť". Treba celé riadky označiť za ušká vľavo, pklik na ušká a vybrať Odstrániť, potom uložiť súbor, a sú preč a nebudú považované za "použité". Lebo inak Vám to aj zväčšuje veľkosť súboru, aj zneprehľadňuje scrolovanie.
Každopádne makro som Vám prerobil tak, že mu je šumák, či je alebo nieje použitých 10000 prázdnych riadkov. Má to ale isté obmedzenia:
-medzera pre prvou tabuľkou musí byť menšia ako výška tabuľky
-medzi tabuľkami a pod tabuľkami nesmú byť žiadne dáta
-tabuľky a medzery medzi nimi musia byť rovnaké (používajú sa totiž násobky)
Dá sa to urobiť aj inak, napr sa spočíta koľko krát sa v stĺpci B vyskytuje text "CELKEM :", a podľa jeho pozície sa určí pozícia tabuľky. Spôsobov je viac.
No ale v tomto prípade reaguje makro zmazaním filtra nielen v prípade zmazania bunky A1, ale hociktorej. Malo by teda radšej prísť k nejakej podobnej úprave:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then If IsEmpty(Target) Then Sheets("Výpožičky").AutoFilter.ShowAllData Else Sheets("Výpožičky").Columns("F:F").AutoFilter Field:=6, Criteria1:=Target
End Sub
To je minimalistická jednoriadková, alebo nejako takto:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
If IsEmpty(Target) Then
Sheets("Výpožičky").AutoFilter.ShowAllData
Else
Sheets("Výpožičky").Columns("F:F").AutoFilter Field:=6, Criteria1:=Target
End If
End If
End Sub
To je rozložené a zrozumiteľnejšie.
Aktivácia bunky - znamená na ňu kliknúť ľavým myšítkom, ak ešte na nej nieste. V 2016 máte a karte Domov skupinu Schránka, a tam šípka, keď na ňu kliknete tak vyberiete Prilepiť špeciálne.
Alebo keď už máte tú násobiacu bunku skopírovanú a želanú oblasť so zápornými číslami označenú, tak na tú označenú oblasť kliknite pravým myšítkom a vyberte - Prilepiť špeciálne.
V oboch prípadoch potom vyberte Násobenie a OK.
Ten môj súbor je stiahnutý 0x. Takže to neskúšate na tom overenom súbore. Vyskúšajte najskôr to. Ja som tam robil ten dotaz nanovo. Kód si môžete spustiť aj manuálne, odkrokujte si ho cez F8. Pri Office 2003 sa nesmie dostať na riadok
Set CON = .Connections("zdrojová data").OLEDBConnection
a pri vyššom Office sa naopak nesmie dostať na riadok
Set CON = .Worksheets("List1").QueryTables("zdrojová data")
Sú súbory na sieti?
Obsahuje ten Váš zdrojový súbor určite rovnakú pomenovanú oblasť?
Rovnakú chybu robí na oboch druhoch Office?
Musíte sa rozpísať viac, ako na jednoslovné odpovede.
Neviem, ako inak pomôcť, keď mne to tu funguje.
Veď ja to robím pod Office 2003, ako Vy. Asi bude rozdiel vo verzii. Aké číslo Vám dáva
Application.Version
?
EDIT:
Zmente toto:
If Application.Version = "11.0" Then
na toto:
If Val(Application.Version) < 12 Then
Musí to fungovať. Teraz to skúšam. Napíšte ešte tú verziu Application.Version a problém môžu byť aj prístupové práva na umiestnenie súboru napr. na sieti.
Krkolomne, ale predsa aspoň nejako sa mi to podarilo poriešiť. Vymeníme v pripájacom dotaze nielen cestu, ale aj poskytovateľa.
Private Sub Workbook_Open()
Dim CS As String, Cesta As String, Poz1 As Long, Poz2 As Long, CON, Prov As String
On Error GoTo CHYBA
With ThisWorkbook
Cesta = .Path & "\zdrojová data.xls"
If Application.Version = "11.0" Then
Set CON = .Worksheets("List1").QueryTables("zdrojová data")
Prov = "Microsoft.Jet.OLEDB.4.0"
Else
Set CON = .Connections("zdrojová data").OLEDBConnection
Prov = "Microsoft.ACE.OLEDB.12.0"
End If
With CON
CS = .Connection
Poz1 = InStr(1, CS, "Provider=") + 8
Poz2 = Len(CS) - InStr(Poz1, CS, ";User") + 1
CS = Left$(CS, Poz1) & Prov & Right$(CS, Poz2)
Poz1 = InStr(1, CS, "Source=") + 6
Poz2 = Len(CS) - InStr(Poz1, CS, ";Mode=") + 1
CS = Left$(CS, Poz1) & Cesta & Right$(CS, Poz2)
.Connection = CS
.Refresh
End With
End With
Exit Sub
CHYBA:
MsgBox ("Chyba pri aktualizácii zdrojovej tabuľky :" & vbNewLine & Cesta)
End Sub
Pripájam pre istotu aj súbor v ktorom mi to fachá obojstranne (XP SP3 + Off2003 SP3 / W10 x64 + Off2016 x64).
Zatiaľ veru neviem, nahodil som si do virtuálky XP s Off2003, ale len čisté XP SP3, aj na Off iba SP3. V Off2003 nieje pod ThisWorkbook objekt Connections, ale iba pod List(x).QueryTables.
Možno je potrebné urobiť kompletnú aktualizáciu OS, Off, .NET, ale to je tak na pol dňa, alebo zapnúť References, žiaľ som neprišiel na to aké.
Prípadne skúsiť vytvoriť u Vás rovnaký dotaz rovnakým spôsobom na rovnakých dátach, v Off 2003, a tieto dotazy by sa použili podmienene podľa verzie Off (ak obdobný dotaz Off 2003 podporuje).
Ja som skúsil napr. MS Query dotaz, ktorý by mal snáď fungovať aj tam aj tam.
Niekto zbehlejší snáď popichne, čo s tým...
Jedno z možných rieš. (maticovo): EDIT - tento prvý má chybu, viď dole - nepoužívať.
=IFERROR(INDEX($G$2:$G$12;MATCH(1;($F$2:$F$12=A2)*($G$2:$G$12>=B2);0));"")
=IFERROR(INDEX($G$2:$G$12;POZVYHLEDAT(1;($F$2:$F$12=A2)*($G$2:$G$12>=B2);0));"")
alebo (maticovo)
=MIN(IF(($F$2:$F$12=A2)*($G$2:$G$12>=B2);$G$2:$G$12))
=MIN(KDYŽ(($F$2:$F$12=A2)*($G$2:$G$12>=B2);$G$2:$G$12))
EDIT:
Alebo skôr takto (maticovo):
=IFERROR(SMALL(IF(($F$2:$F$12=A2)*($G$2:$G$12>=B2);$G$2:$G$12);1);"")
=IFERROR(SMALL(KDYŽ(($F$2:$F$12=A2)*($G$2:$G$12>=B2);$G$2:$G$12);1);"")
1. vzorec nevráti správnu hodnotu, ak nebudú hodnoty v G zoradené vzostupne. Čo je chyba, pretože nemusí byť hodnotovo najbližšia hodnota najbližšie k začiatku.
2. vzorec je OK, len vracia pri nenájdení vhodnej hodnoty číslo 0.
3. vzorec je OK nevracia 0 ak nevyhovuje žiadna hodnota, ani nemusia byť hodnoty vzostupné.
Ak sa nemýlim, toto by mala byť odpoveď na Vašu otázku, ale mne sa to žiaľ nepodarilo rozbehať. Skúste...
Link to a specific PowerPoint 2003, 2007 or 2010 slide from Microsoft Word or Excel
Keďže sa mi nedá editovať posledný príspevok, a nieje to z neho celkom jasné
...Filename:=Cesta & OdstranHovadiny(Nazev, "-")...
tak pridávam trochu prerobenú verziu, viac v popise makra a v prílohe.
Function PrecistiNazov(Hodnota As String, Nahrad As String, Odporucane As Boolean, Optional KontrolaNahrad = True) As String
Dim i As Byte, arrN, DN As Byte, DH As Byte, LH As Byte
If Len(Hodnota) = 0 Then GoTo CHYBA
DN = Len(Nahrad)
If KontrolaNahrad Then
If DN <> Len(PrecistiNazov(Nahrad, "", Odporucane, False)) Then GoTo CHYBA 'Prečistenie nahradzovacieho reťazca
End If
arrN = Array(Chr(255), "/", ":", "*", "?", "„", "<", ">", "|", "\", "#", "%", "&", "{", "}", "=") 'Pole nahradzovaných znakov
Hodnota = WorksheetFunction.Trim(Hodnota) 'Ošetrenie nadbytočných medzier, zlomov ...
For i = 0 To IIf(Odporucane, UBound(arrN), 9) 'Nahradenie vybraných sád znakov
Hodnota = Replace(Hodnota, arrN(i), Nahrad)
Next i
If DN <> 0 Then
Hodnota = Replace(Replace(Replace(Hodnota, Nahrad, "/::"), "::/", ""), "/::", Nahrad) 'Ošetrenie duplicít nahradzovacích reťazcov
DH = Len(Hodnota)
If DH > DN Then
LH = IIf(Left$(Hodnota, DN) = Nahrad, DN, 0)
Hodnota = Mid$(Hodnota, LH + 1, DH - LH - IIf(Right$(Hodnota, DN) = Nahrad, DN, 0)) 'Ošetrenie výskytu nahradzovacích reťazcov na okrajoch
End If
End If
PrecistiNazov = Hodnota
Exit Function
CHYBA:
PrecistiNazov = "" 'V prípade chyby vráti ""
'PrecistiNazov = CVErr(xlErrValue) 'V prípade chyby vráti #HODNOTA + treba zmeniť návratovú premennú na Variant
End Function
Dá sa to urobiť na 100 spôsobov, s rôznymi "vylepšeniami". Nech si každý doplní, myslím, že je to teraz úplne jasné.
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