Příspěvky uživatele

Jedine makrom. Viete, kde bude ten súbor summary.xlsx umiestnený? Bude to vždy rovnaká zložka ako ten otváraný súbor year.xlsx?

Makro do modulu ThisWorkbook/Tento_zošit
Private Sub Workbook_Open()
Dim Cesta As String, Soubor As String, List As String
Dim Sloupec
Dim bNeprepisovat As Boolean

Cesta = ThisWorkbook.Path & "\"
Soubor = "summary.xlsx"
List = "Summary"

With Worksheets("Year")
Sloupec = Application.Match(CDbl(Date), .Rows(1).Value2, 0)

If IsError(Sloupec) Then
MsgBox "Dnešní datum " & Format(Date, "d.m.yyyy") & " se v souboru nevyskytuje.", vbCritical
Exit Sub
End If

Cesta = "'" & Cesta & "[" & Soubor & "]" & List & "'!C4"

With .Cells(2, Sloupec).Resize(4)

If WorksheetFunction.CountBlank(.Resize(4)) <> 4 Then
.Activate
bNeprepisovat = MsgBox("V oblasti datumu " & Format(Date, "d.m.yyyy") & " se již nacházejí data." & vbNewLine & _
"Chcete je přepsat ?", vbYesNo + vbExclamation) = vbNo
End If

If bNeprepisovat Then
MsgBox "Nic nebylo zapsáno.", vbInformation
Else
.Formula = "=IF(" & Cesta & "="""",""""," & Cesta & ")"
.Value = .Value
End If
End With
End With
End Sub

Sharepoint (SP) nemám ako vyskúšať.

Berme do úvahy spomínaný nefunkčný variant s SP:

Ak otvoríte súbor "matricePQ-nacitani.xlsm", čo je v parametroch "Soubor" a "Cesta"?

Ak dáte vytvoriť pokusný nový dotaz:
Záložka Údaje - Získať údaje - Zo súboru - Z priečinka služby SharePoint
a zadáte Vašu SP adresu
https://lannuttigroup-my.sharepoint.com/personal/radek_braum_lannutti_com/Documents/pokus/kj
dostanete nejaký zoznam súborov?

Problém s lomítkami samozrejme bude, lebo lokálne úložisko je "\" a internet "/".

Každopádne, ak tento pokus zobrazí nejakú adresárovú štruktúru na SP, tak je dosť pravdepodobné, že po úprave kódu (lomítka) bude pracovať ako s normálnymi súbormi. Ja budem stále iba tipovať (SP nemám), ale posunie nás to ďalej.

Zaujímavosť:
Vedeli ste, že v novom Exceli 365 je možnosť nájsť zaplnenú oblasť takto ?
parametre určujú či orezať stĺpec/riadok a na konci/začiatku
=TRIMRANGE(Nastavení!$B$2:$B$16;2)
=ROZSAH_STŘIHU(Nastavení!$B$2:$B$16;2)
alebo
bodka určuje rez na začiatku ".:" alebo na konci ":."
=Nastavení!$B$2:.$B$16
Po starom napr.
=OFFSET(Nastavení!$B$2;;;COUNT(Nastavení!$B$2:$B$16))
=POSUN(Nastavení!$B$2;;;POČET(Nastavení!$B$2:$B$16))

Celkom dosť zaujímavé...

Sviatky môžu aj nemusia byť dynamické. Záleží na tom, ako často sa u Vás menia. Ak pre istotu, tak stačí zrátať napr. 15 buniek B2:B16 (viac ako 2 sviatky Vám nepridajú, skôr naopak) a nie celých milión riadkov.

Tento Váš súbor je opäť XLS, a neviem či to je tým, že ste to tam Vy nechcel, alebo to podmienené formátovanie (PF) odstránil prevod do XLS. (PF na spodné orámovanie podľa počtu dní, a zmiešané sfarbenie víkendu počas sviatku)

Ešte ma napadá, že "mesiace" v D2:D13 nemusia tiež počítať =DATE(rok;1;1) atď., ale stačí tam zadať hocijaký dátum v akomkoľvek roku napevno (napr. 1.1.2020). To je fuk, lebo ide iba o to, aby výberový zoznam mal názvy mesiacov podľa jazykového nastavenia a správne fungoval. Dátum pre označenie dní 1...31 sa potom začína zistením mesiaca, teda rok je irelevantný. Ak by to takto riešené nebolo, muselo by sa napr. hľadať číslo vybraného mesiaca v zozname českých mesiacov ako texty, alebo inak. Ja v SK Office by som mohol mať problém. Ale tu ma napadá ešte lepšie riešenie použiť kód jazyka CZ (0405 či cs-CZ) do Formátu bunky. A potom sa aj v SK Exceli zobrazia CZ názvy.

A ešte poznámka: Dajú sa pomocou PF aj skryť (zafarbiť na bielo) dátové riadky v mesiaci navyše. To ale môže viesť k problému, že ich neuvidíte, nezmažete, ale niekde inde ich môžete napr. spočítavať. Teda výhodnejšie je ich nechať zobrazené, aby Vám to udrelo do očí, že to tam nemá čo robiť. Alebo aj prípadné napr. súčtové operácie prispôsobiť dynamickému rozsahu mesiaca, aby ich vynechalo. Treba myslieť aj na to.

V prílohe som pridal ten CZ kód.

Do OneDrive sa púšťať nebudem. Čo si tak pamätám, tak je problém získať rovnaký typ adresy, ako v akýchkoľvek návodoch. Potom inak je to v OD Personal a inak v OD Business. Načítať adresárovú štruktúru sa asi nedá. Problém s povereniami. MS inštruuje - stiahnite si súbory do PC alebo prejdite na SharePoint :) Ak súbor zmažete a nahradíte súborom s rovnakým názvom, nesedí link. No je to hrôza.
Ak máte ale tie súbory s OD synchronizované, teda máte ich v PC v zložke OneDrive, tak by to malo fungovať ako normálna PC zložka.
Ak sa Vám chce čítať množstvo problémov, pohľadajte niečo v zmysle "powerquery onedrive folder structure"...

Nemôžete použiť formát súboru XLSX? Pri ukladaní do XLS sa stratí možnosť voľby mesiaca, ak je na druhom liste. Predsa len Office pre XLSX je od roku 2007.

EDIT: Tak XLSX...

Ak máte Office 2021/2024/365 tak mi to pošlite mailom alebo na nejaké verejné úložisko to capnite (Google Disk a pod). Samozrejme iba ak je to zverejniteľné.

Pr.

Ako píše "€Ł мσşqμΐτσ", treba pridať príklad takých dát. Inak aký máte Excel? V novších verziách sa dá načítať PDF do PowerQuery, a tam by sa to možno dalo ošetriť (podľa toho ako to PDF vyzerá).

Toto znamená, že sa prvý znak vloží do výsledku bez kontroly, a cyklus začína na znaku 2.
...
xOut = VBA.Left(pValue, 1)
For i = 2 To VBA.Len(pValue)
...
Editnem moju fnc v príspevku vyššie, aby brala celý reťazec.

EDIT: Napadá ma predsa len dôvod, prečo vynechať 1. písmeno. Ak sa jedná o pridanie medzery do zle zložených mien. Namiesto "MenoPriezvisko" urobí "Meno Priezvisko". V takomto prípade je nutné vynechanie 1. znaku, aby nevzniklo " Meno Priezvisko". Takže aký je účel?

Pridal som voliteľný parameter Start, ktorý určuje, od ktorého znaku sa má začať s kontrolou a pridávaním medzery. Ak sa parameter vynechá, začína sa od 1. znaku:
Function AddSpaces(pValue As String, Optional Start As Long = 1) As String
Dim xOut As String, CH As String, chU As String, U As String, L As String

U = UCase(pValue)
L = LCase(pValue)
xOut = Mid(pValue, 1, Start - 1)

For i = Start To Len(pValue)
chU = Mid(U, i, 1)
CH = Mid(pValue, i, 1)
If StrComp(chU, Mid(L, i, 1), vbBinaryCompare) <> 0 Then 'iba ak je to písmeno
CH = IIf(CH = chU, " ", vbNullString) & CH 'ak je to veľké písmeno, pridaj medzeru
End If
xOut = xOut & CH
Next i

AddSpaces = xOut
End Function

Samozrejme to pôjde, ale najskôr otázka :
Prečo sa vynecháva ten 1. znak ???
Function AddSpaces(pValue As String) As String
Dim xOut As String, CH As String, chU As String, U As String, L As String

U = UCase(pValue)
L = LCase(pValue)

For i = 1 To Len(pValue)
chU = Mid(U, i, 1)
CH = Mid(pValue, i, 1)
If StrComp(chU, Mid(L, i, 1), vbBinaryCompare) <> 0 Then 'iba ak je to písmeno
CH = IIf(CH = chU, " ", vbNullString) & CH 'ak je to veľké písmeno, pridaj medzeru
End If
xOut = xOut & CH
Next i

AddSpaces = xOut
End Function

Ak chcete priložiť súbor s makrom (.XLSM), musíte ho zabaliť do ZIP, inak ho fórum nezoberie. A veľkosť je tiež obmedzená, no neviem na koľko, možno do 300 KB.

Tu máte všetky 3 verzie. Verzie "pole" a "vzorec" vracajú výsledok zatiaľ do druhého listu (dá sa prerobiť aby nahrádzali pôvodné), a posledná verzia "stĺpce" nahrádza pôvodné. Prvé dve sú najrýchlejšie, ale ak by tam boli nejaké nesúrodé formáty, orámovania a pod, nebude to logicky fachať. Naopak posledný variant "stĺpce" je síce najpomalší, ale ponechá nesúrodé formáty apod.

Verzia "vzorec" v Office 2016 fungovať nebude, ostatné áno.

Nemáte náhodou Office 365 verziu?
Ak áno, tak môžete získať výsledok extrémne rýchlo iba jediným obyčajným vzorcom
=FILTER(A1:C51600;BYROW((LEFT(A1:A51600;{2\1\1\1})={"EN"\"Z"\"S"\"B"})*1;SUM)=0)
=FILTER(A1:C51600;BYROW((ZLEVA(A1:A51600;{2\1\1\1})={"EN"\"Z"\"S"\"B"})*1;SUMA)=0)

Takto by vyzeralo makro, ktoré vypočíta daný vzorec cez EVALUATE. Ako vidíte získať výsledok je 1 riadok, ostatné je omáčka. Zatiaľ do 2. hárku, je možné aj nahradiť do pôvodného, takto som to dal pre kontrolu. Zmenšil som dáta na 10K, aby mi to sem vošlo. Rozdiel medzi 10K vs 50K je takmer nepostrehnuteľný. Celkovo sú to iba desatiny sekundy.
Sub smazat()
Dim V
Dim RNG As Range
Dim Col As Integer, i As Integer
Dim F As String
Dim aF() As String

Col = 1
F = "EN,Z,S,B"

Set RNG = Worksheets("Hárok1").UsedRange

aF = Split(F, ",")
F = """" & Replace(F, ",", """,""") & """"
For i = LBound(aF) To UBound(aF): aF(i) = Len(aF(i)): Next i

V = Evaluate("=FILTER(" & RNG.Address(External:=True) & ",BYROW((LEFT(" & RNG.Columns(Col).Address(External:=True) & ",{" & Join(aF, ",") & "})={" & F & "})*1,SUM)=0)")
'=FILTER(A1:C51600;BYROW((LEFT(A1:A51600;{2\1\1\1})={"EN"\"Z"\"S"\"B"})*1;SUM)=0)

With Worksheets("Hárok2")
.UsedRange.ClearContents
If IsError(V) Then
MsgBox "Žiadne dáta nevyhovujú filtru.", vbExclamation
Else
.Activate

With .Cells(RNG.Row, RNG.Column)
.Resize(UBound(V, 1), UBound(V, 2)).Value = V
.Select
End With
End If
End With
End Sub
Ak nemáte Office 365 pôjdem sa piplať aj s inými verziami...

EDIT:
Pre Office 2024 musí byť vo vzorci explicitne aj LAMBDA
=FILTER(A1:C51600;BYROW((LEFT(A1:A51600;{2\1\1\1})={"EN"\"Z"\"S"\"B"})*1;LAMBDA(A;SUM(A)))=0)
=FILTER(A1:C51600;BYROW((ZLEVA(A1:A51600;{2\1\1\1})={"EN"\"Z"\"S"\"B"})*1;LAMBDA(A;SUMA(A)))=0)

Priložte prílohu s príkladom, ako vyzerajú tie dáta (anonymizované). Nech je vidno aj či a aké sú tam vzorce, dátové typy a formáty. Aj napíšte koľko sa približne nachádza vymazávaných riadkov v 50K tabuľke.
Suverénne najrýchlejšie by bolo, ak tam nie sú vzorce, preliať tie dáta iba v poli cyklom a pôvodné nahradiť.
Lebo ako som písal ja aj lubo, ak je tých subrange v range veľa je to pomalé, inak je to výhodné. Ak tam budú iba dáta, urobil by som to cez pole, ak aj vzorce, tak spomenutou lubovou metódou.

Robil som pokus, na 56K tabuľke, kde bolo k vymazaniu 7200 riadkov. A je to pomalé aj pri rozdelení na 1000 alebo 500 riadkov (nesusediacich) v jednom mazanom range. Meranie času síce ukáže pár sekúnd, ale reálne Excel nereaguje >40s.

Po obede by som mohol mať čas, tak priložte tú prílohu.

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje