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

Příspěvky uživatele

Sub Vymaz_Err()
Dim PrvniRadekDat As Long, PoslRadekDat As Long, Radku As Long, SloupecDat As Integer, Data(), i As Long, rngErr As Range

PrvniRadekDat = 5
SloupecDat = 9

With ThisWorkbook.Worksheets("DATA")
PoslRadekDat = .Cells(.Rows.Count, SloupecDat).End(xlUp).Row
If PoslRadekDat < PrvniRadekDat Then MsgBox "Žádná data.", vbInformation: Exit Sub
Radku = PoslRadekDat - PrvniRadekDat + 1
ReDim Data(1 To Radku, 1 To 1)
If Radku = 1 Then Data(1, 1) = .Cells(PrvniRadekDat, SloupecDat).Value Else Data = .Cells(PrvniRadekDat, SloupecDat).Resize(Radku).Value
For i = 1 To Radku
If Data(i, 1) = "err" Then
If rngErr Is Nothing Then Set rngErr = .Cells(PrvniRadekDat + i - 1, SloupecDat - 1) Else Set rngErr = Union(rngErr, .Cells(PrvniRadekDat + i - 1, SloupecDat - 1))
End If
Next i
If Not rngErr Is Nothing Then rngErr.ClearContents
End With
End Sub

Je to možné. Tak tu je návrh na UDF (funguje aj maticovo aj v PF):
Function CHECK_FORMULA(RNG As Range) As Variant
Dim x As Integer, y As Long, arr() As Boolean
If Not TypeName(RNG) = "Range" Then
CHECK_FORMULA = CVErr(xlErrRef)
Else
If RNG.Cells.Count = 1 Then
CHECK_FORMULA = RNG.HasFormula
Else
ReDim arr(1 To RNG.Rows.Count, 1 To RNG.Columns.Count)
For x = 1 To UBound(arr, 2)
For y = 1 To UBound(arr, 1)
arr(y, x) = RNG.Cells(y, x).HasFormula
Next y
Next x
CHECK_FORMULA = arr
End If
End If
End Function

Overuje to existenciu vzorca v bunkách. Rovnako som žlté podfarbenie dal na PF, nie ručne.

Obojsmerne. Snáď som neurobil hrubku...

=IF(OR(B3="";D3="");"";VLOOKUP(B3;$I$3:$M$6;MATCH(D3;$J$2:$M$2;0)+1;FALSE))
=KDYŽ(NEBO(B3="";D3="");"";SVYHLEDAT(B3;$I$3:$M$6;POZVYHLEDAT(D3;$J$2:$M$2;0)+1;NEPRAVDA))

Prvý riadok píšem vždy SK vzorec, druhý CZ vzorec (SK má rovnaké názvy funkcií ako EN, ale EN má oddeľovače parametrov "," a v SK/CZ je to ";").

Tak pridajte do SUMPRODUCT/SOUČIN.SKALÁRNÍ ešte jednu podmienku:
=SUMPRODUCT((Tabulka1[[Model]:[Model]]=$G3)*(MONTH(Tabulka1[[Datum prodeje]:[Datum prodeje]])=COLUMN(A$1))*(Tabulka1[[Datum prodeje]:[Datum prodeje]]<>0))
=SOUČIN.SKALÁRNÍ((Tabulka1[[Model]:[Model]]=$G3)*(MĚSÍC(Tabulka1[[Datum prodeje]:[Datum prodeje]])=SLOUPEC(A$1))*(Tabulka1[[Datum prodeje]:[Datum prodeje]]<>0))
Inak hodnoty z KT sa v tomto prípade dajú získať aj cez =GETPIVOTDATA("Model";$M$3;"Model";"AA";"mesiace";1)
=ZÍSKATKONTDATA("Model";$M$3;"Model";"AA";"mesiace";1)

(v CZ to bude asi "měsíce")

Ale žiaľ, keď zmažem nejaký dátum zo zdroja a dám Refresh KT, tak ju rozmrdá. Nesmie tam byť prázdny dátum, a funguje OK. Neviem či to tak robí len u mňa (E2019 verzia 1808 zostava 10730.20102, W10 x64 Pro SK verzia 1809 zostava 17763.195), overovať sa mi to nechce.

Do H3 a natiahnuť:
=SUMPRODUCT((Tabulka1[[Model]:[Model]]=$G3)*(MONTH(Tabulka1[[Datum prodeje]:[Datum prodeje]])=COLUMN(A$1)))
=SOUČIN.SKALÁRNÍ((Tabulka1[[Model]:[Model]]=$G3)*(MĚSÍC(Tabulka1[[Datum prodeje]:[Datum prodeje]])=SLOUPEC(A$1)))
Alebo KT.

Ale to sa asi nedá použiť na zatvorený súbor. Ak je súbor otvorený, poznáme meno listu a adresu bunky, tak to funguje takto:
txt = ExecuteExcel4Macro("GET.NOTE(""[pok2.xlsm]Hárok1!R2C2"")")

Keďže sa súbor nesmie otvoriť, môže sa rozzipovať ? Ak áno, tak:
-skopírovať súbor do tempu, premenovať na *.zip, rozbaliť (všetko vo VBA samozrejme)
-ak súbor obsahuje komentáre, tak v podzložke "xl" budú súbory "comments1.xml", "comments2.xml",...
-z nich sa dá vyčítať autor, bunka, text a formát textu
-v podzložke xl\worksheets\_rels\ je v každom sheetXY.xml ... uvedený názov "commentsXY.xml" ktorý mu patrí. V listoch v ktorých niesú komenty, tento odkaz nieje.
-všetko parsovať buď klasicky cez text alebo cez Nodes v Microsoft.XMLDOM.
-na záver by sa extrahovaná zložka aj kópia súboru mázli.

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 ?

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse