Příspěvky uživatele

milos85: Takto ???

A čo to skúsiť pomocou PF?

Príloha nič neobsahuje. Veľkosť 22 bytov.

Pr.
Sub Pocet_stran()
Dim xStr As String, xFdItem As String, xFileName As String
Dim xFileNum As Long, Count As Long
Dim RegExp As Object, FSO As Object, File As Object
Dim F()

With Application.FileDialog(msoFileDialogFolderPicker)
If .Show <> -1 Then MsgBox "Nevybrali ste žiadny adresár": Exit Sub
xFdItem = .SelectedItems(1) & IIf(Right$(.SelectedItems(1), 1) = Application.PathSeparator, "", Application.PathSeparator)
End With

wsOld.UsedRange.ClearContents
With wsCiel.Range("A1:C1").Resize(wsCiel.Cells(Rows.Count, 1).End(xlUp).Row)
wsOld.Range("A1:C1").Resize(.Rows.Count).Value = .Value
.Offset(1, 0).ClearContents
End With

Set FSO = CreateObject("Scripting.FileSystemObject")
Set RegExp = CreateObject("VBscript.RegExp")

With FSO.GetFolder(xFdItem)
For Each File In .Files
xFileName = File.Name
If LCase(FSO.GetExtensionName(xFileName)) = "pdf" Then
Count = Count + 1
ReDim Preserve F(1 To 3, 1 To Count)
F(1, Count) = xFileName
F(3, Count) = File.DateLastModified
With RegExp
.Global = True
.Pattern = "/Type\s*/Page"
xFileNum = FreeFile
Open (xFdItem & xFileName) For Binary As #xFileNum
xStr = Space(LOF(xFileNum))
Get #xFileNum, , xStr
Close #xFileNum
F(2, Count) = .Execute(xStr).Count
End With
End If
Next File
End With

If Count > 0 Then
wsCiel.Range("A2:C2").Resize(Count).Value = Application.Transpose(F)
wsCiel.Columns("A:C").AutoFit
Else
MsgBox "Žiadne súbory PDF"
End If

Set FSO = Nothing: Set RegExp = Nothing: Set File = Nothing
End Sub

Pr.

milos85 : COUNTIF() s parametrom čo sme teraz získali &"?" prípadne &"*"

Barth : Kedysi som robil vzorce na vyťahovanie čísel z akýchkoľvek reťazcov, nemôžem to nájsť. Uveďte príklad, možno poriešime ...

Aha, no však dá sa aj tak samozrejme.

Ešte o mikrokúštik kratšie :)
=LEFT(A1;LEN(A1)-IFERROR(RIGHT(A1)*0;1))
=ZLEVA(A1;DÉLKA(A1)-IFERROR(ZPRAVA(A1)*0;1))

Áno myslel som na to, no nakoniec prevážila myšlienka, že nevieme čo obsahuje ten "txt", a čo ak tam bude tiež "/", tak som to spravil radšej takto :)

Skúsim iba zľahka.
Pomocný stĺpec je v oboch Tabuľkách na konci - skrytý.
Vypozoroval som, že dátumu vždy predchádza "/".
Vzorec funguje približne takto:
-nahradí "/" za počet medzier rovnajúcich sa dĺžke raťazca, tento trik sa používa na rozdelenie textu na úseky/slová či získanie N-tej časti.
txXt010018/24.01.2020
txXt010018                     24.01.2020
-Teraz zoberieme zprava toľko znakov, aká je dĺžka origo textu
           24.01.2020
-A teraz keď máme 11 medzier a textodátum, prevedieme tento textodátum na dátum
DATEVALUE("           24.01.2020")
DATUMHODN("           24.01.2020")
-a máme dátum 24.1.2020, ktorý môžeme testovať voči našej podmienke Datum!D3 a Datum!D4 (preto musí byť vo vzorci ešte jedno rovnaké počítanie pre druhý interval)
-samozrejme je to obalené v IFERROR, pre prípad, že tam dátum nebude, a pri prevode na dátum nastane chyba.

-lenže my toto celé nerobíme s bunkou, ale s 18-stimi, a teda nám vznikne maticovým vzorcom pole 0 a 1, ktoré pomocou SUM/SUMA spočítame.
Napr v 4. raidku
SUM(0/1/1/1/FALSE/FALSE/FALSE/FALSE/FALSE/FALSE/FALSE/FALSE/FALSE/FALSE/FALSE/FALSE/FALSE/FALSE)
SUMA(0/1/1/1/NEPRAVDA/NEPRAVDA/NEPRAVDA/NEPRAVDA/NEPRAVDA/NEPRAVDA/NEPRAVDA/NEPRAVDA/NEPRAVDA/NEPRAVDA/NEPRAVDA/NEPRAVDA/NEPRAVDA/NEPRAVDA)
-a tento súčet nám udáva koľkokrát sa v 18 stĺpcoch nachádza dátum v rozmedzí intervalov, ak je >0 tak je výsledkom číslo riadku dát v Tabuľke, ak je 0 tak ""
-tieto výsledky (čísla riadkov) sú logicky teda aj zoradené vzostupne.

A teda vo výslednej Tabuľke:
-potom pomocou vzorca zisťujeme na každom riadku zdrojový riadok
SMALL(stĺpec;koľká najmenšia hodnota)
"stĺpec" - je ten výsledný pomocný skrytý stĺpec na konci zdrojovej Tabuľky
"koľká najmenšia hodnota" - tu si pomocou relatívneho adresovania zabezpečíme, že vzorec na každom riadku bude ťahať o jedno väčšie číslo z výsledkov v zdroji (vždy ďalší riadok)
ROW(A1)
ŘÁDEK(A1)
-A potom už iba indexujeme data tak, že ich najskôr skontrolujeme, či nieje výsledná bunka prázdna, lebo by nám to ťahalo 0.

fertig

Najjednoduchší spôsob vzorcami je asi takto - pomocný stĺpec v každej Tabuľke.

Maticový vzorec vynechá prázdne riadky.

Podľa toho, čo som čítal na niekoľkých fórach, nie si sám čo mu tento bug "spríjemňuje" život. Opravujú to už vraj 2 roky, tak by som sa príliš na nápravu nespoliehal. Všeobecná zhoda je zatiaľ na použití ExcelTable ako jediného objektu na liste a začínajúcej v A1. Číta to potom ako akýkoľvek iný list bez ExcelTable.
let
Source = Excel.Workbook(File.Contents("D:\Dokumenty\pom.xlsb"), null, true),
xlTbl_CatalogueData_Table = Source{[Name="CataloguedData"]}[Data],
#"Hlavičky so zvýšenou úrovňou" = Table.PromoteHeaders(xlTbl_CatalogueData_Table, [PromoteAllScalars=true])
in
#"Hlavičky so zvýšenou úrovňou"

Presne tak. Snažíte sa vytvoriť podadresár v neexistujúcom adresári. Použite nejakú parametrizovanú procedúru na vytvorenie celej adresárovej štruktúry. Napr. narýchlo takéto niečo:
Sub VytvorAdresar(Cesta As String)
Dim sC() As String, dC() As String, i As Byte
If Right$(Cesta, 1) <> "\" Then Cesta = Cesta & "\"
dC = Split(Cesta, ":\")
sC = Split(dC(1), "\")
Cesta = dC(0) & ":"
For i = 0 To UBound(sC)
If sC(i) <> "" Then
Cesta = Cesta & "\" & sC(i)
If Len(Dir(Cesta, vbDirectory)) = 0 Then MkDir Cesta
End If
Next i
End Sub

Areas za iných okolností áno, ale nie v UsedRange. Tu by sa muselo asi zisťovať po jednom, či bunka obsahuje rám, podmienený formát, overenie údajov a pod. Samozrejme hodnotu, ale tá by sa ako jediná dala testovať rýchlo cez pole, či hromadne cez SpecialCells, prípadne maticovým EVALUATE s testom riadkov aj stĺpcov. Jednoduché to nebude.

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje