Příspěvky uživatele
< návrat zpět
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.
To je naschvál tak urobené. Pre kontrolu správnej funkčnosti. V kóde sú 2 riadky. Mazací je vypnutý pomocou apostrofu. Ak si to skontrolujete, tak vypnite Select a zapnite Delete.
rngDEL.EntireRow.Select
' rngDEL.EntireRow.Delete
Makro je urobené tak, aby mazalo všetky riadky naraz. To je výhodné časovo, ale iba do nejakého rozumného počtu. Range sa preťaží. Ak by to trvalo neúmerne dlho (napr. dlhšie ako pôvodný spôsob), tak tam doplním, aby napr. každých 1000 nájdených riadkov vykonalo výmaz. Potom nebude Range preťažovaná.
No problema...
Sub smazat()
Dim Countrow As Long
Dim R As Long, c As Long
Dim CalcMode As Long
Dim ViewMode As Long
Dim rngDEL As Range
Dim aVal()
Dim aCon() As String
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
End With
With ActiveWindow
ViewMode = .View
.View = xlNormalView
End With
aCon = Split("EN,Z,S,B", ",")
With ActiveSheet.UsedRange
.Parent.DisplayPageBreaks = False
Countrow = .Rows.Count
If .Column <> 1 Then
MsgBox "Použitá oblast nezačíná sloupcem A", vbExclamation: Exit Sub
End If
If Countrow = 1 Then
ReDim aVal(1 To 1, 1 To 1)
aVal(1, 1) = .Cells(1, 1).Value
Else
aVal = .Columns(1).Value
End If
For R = 1 To Countrow
For c = 0 To UBound(aCon)
If Left(aVal(R, 1), Len(aCon(c))) = aCon(c) Then
If rngDEL Is Nothing Then
Set rngDEL = .Cells(R, 1)
Else
Set rngDEL = Union(rngDEL, .Cells(R, 1))
End If
Exit For
End If
Next c
Next R
End With
If Not rngDEL Is Nothing Then
rngDEL.EntireRow.Select
' rngDEL.EntireRow.Delete
End If
ActiveWindow.View = ViewMode
Application.Calculation = CalcMode
End Sub
Neviem či nie je rozdiel "pre firmy" a "pre veľké organizácie".
Ako píše Dingo, vo verzii "pre veľké organizácie" sa to nachádza v menu Štart.
W10/W11
Štart - napísať "Spreadsheet Compare"
alebo
W10
Štart - Nástroje balíka Office - Spreadsheet Compare
W11
Štart - Všetko - Nástroje balíka Office - Spreadsheet Compare
Citácia z webu MS:
Important: Spreadsheet Compare is only available with Office Professional Plus 2013, Office Professional Plus 2016, Office Professional Plus 2019, or Microsoft 365 Apps for enterprise.
vľavo:
=SUMIF($C$2:$Y$2;"<"&TODAY();C3:Y3)
=SUMIF($C$2:$Y$2;"<"&DNES();C3:Y3)
vpravo:
=SUMIF($C$2:$Y$2;">="&TODAY();C3:Y3)
=SUMIF($C$2:$Y$2;">="&DNES();C3:Y3)
alebo
=SUM(C3:Y3)-B3
=SUMA(C3:Y3)-B3
No k tomu nie je príliš čo vysvetľovať.
Jedno NestedJoin s parametrom LeftAnti vráti riadky, ktoré sú v prvej tbl a nie sú v druhej, a druhé NestedJoin naopak vráti riadky ktoré sú v druhej tbl a nie sú v prvej.
A aby sme tieto 2 výsledky rozlíšili, pridáme k nim stĺpec s hodnotou, či sa jedná o výsledok Navíc alebo Chybí.
Tento stĺpec sa dá potom po spojení výsledkov efektne použiť v Rýchlom filtri.
Stĺpec QQ, ktorý pri NestedJoin vzniká je irelevantný, mažeme ho.
PQ?
Ak budem brať ako identifikátor celý riadok, tak by som to asi rýchlo urobil s 2 pomocnými stĺpcami.
Aha súbor má 558 KB, nevlezie sem, tak vzorce:
List "actual":
stĺpec "Kontrola"
=TEXTJOIN("•";FALSE;AxTable1[@[Typ řádku]:[ID řádku úpravy]])
=TEXTJOIN("•";NEPRAVDA;AxTable1[@[Typ řádku]:[ID řádku úpravy]])
stĺpec "Check"
=IF(ISNA(MATCH([@Kontrola];AxTable15[Kontrola];0));"Navíc";"")
=KDYŽ(JE.NEDEF(POZVYHLEDAT([@Kontrola];AxTable15[Kontrola];0));"Navíc";"")
List "old test":
stĺpec "Kontrola"
=TEXTJOIN("•";FALSE;AxTable15[@[Typ řádku]:[ID řádku úpravy]])
=TEXTJOIN("•";NEPRAVDA;AxTable15[@[Typ řádku]:[ID řádku úpravy]])
stĺpec "Check"
=IF(ISNA(MATCH([@Kontrola];AxTable1[Kontrola];0));"Chybí";"")
=KDYŽ(JE.NEDEF(POZVYHLEDAT([@Kontrola];AxTable1[Kontrola];0));"Chybí";"")
A potom si len dáte filtre na stĺpce Check.
To je jednoduché, len musíte pred prepisom dočasne vypnúť udalosti, lebo by sa dokola volal znovu opačný prepis.
No a aký máte Office? Lebo tam je tých funkcií viac použitých.
Môžete to urobiť obdobne pomocou Kontingenčných tabuliek s WC vo Filtre, materiálom ako Riadky, a Hodnota bude UKONČENÍ s voľbou Maxima.
Uživatelské menu
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
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.
RSS nejnovější články