Příspěvky uživatele
< návrat zpět
Jaxem psal ve svém předposledním příspěvku, pro Vás mi přijde nejlepší načíst data z již otevřeného (programem vytvořeného) sešitu. Ten pak zahodit nebo pokud potřebujete uložit a zavřít. Toto bude nejrychlejší metoda.
Pokud chcete někoho podpořit myslím, že se nikdo bránit nebude. Stačí si vyžádat číslo účtu ;)
Mno, asi takhle - něco z toho je řešitelné pomocí Google api - viz obrázek.
Nicméně plánování trasy na mapy cz bude problém, protože tam je rozhodující nějaký parametr rc, který se dá snad zjistit pomocí objektu SMap.Route, pokud jsem správně pochopil. Bez tohoto parametru jste nahraný a HT-odkaz prostě nevytvoříte - resp. já ho nevytvořil. A protože to nikdy nepoužiju, ani se ho nebudu snažit vytvořit.
Toto Vám vrátí text. Použijte funkci DATUM
=DATUM(D8;C8;B8)
Nejdříve se podívejte se, zda nemáte buňku formátovanou jak text. A pokud to chcete řešit ještě měsíc, nevadí. Pokud to chcete mít vyřešené ještě dnes, vložte sem přílohu a někdo na to koukne.
Musí to fungovat. Pokud ne, zkontrolujte zda v datech nemáte překlep nebo zda nemáte vypnuté přepočty
@Dingo
Pro přehlednější nastavení data bych to dal klidně takto=COUNTIFS(Databáze!$A:$A;"Internet Mall*";Databáze!$C:$C;">"&DATUM(2014;12;31)")
Vím, že je to už naprosto mimo téma, ale zajímalo mně to a možná to zajímá i někoho jiného.
Zkusil jsem otestovat 3 typy načtení csv souboru o různých počtech řádků (počet řádků je v názvu souboru) a 6 sloupcích.
FileSystem - načtení pomocí fso viz kód výše, ještě jsem jej mírně optimalizoval.
OpenCLose - otevření souboru csv, načtení dat a zavření souboru
QueryTable - načtení dat pomocí QueryTable s vytvořením dočasného listu
Časy jsou v sekundách
Ve všech třech metodách pouze načtu data do pole a tím kód končí (data v poli jsou připravena k vložení). Je krásně vidět, že fso není vůbec ovlivněno otevřením dalších souborů a získává si mé sympatie. Jsem překvapen, že mu nedělá problém ani 28MB soubor.
Otevřen pouze soubor, kde je spuštěn kód#No FileName FileSize FileSystem OpenClose QueryTable
1 CSV001000.csv 38kB 0,016 0,152 0,102
2 CSV010000.csv 416kB 0,152 0,234 0,266
3 CSV017000.csv 737kB 0,258 0,328 0,402
4 CSV035625.csv 1 592kB 0,543 0,445 0,766
5 CSV071250.csv 3 227kB 1,066 0,789 1,438
6 CSV142500.csv 6 663kB 2,164 1,477 2,879
7 CSV285000.csv 13 760kB 4,391 3,105 5,824
8 CSV570000.csv 27 955kB 9,930 6,809 11,930Otevřen soubor, kde je spuštěn kód a soubor, který obsahuje tisíce výpočtů, ale žádné externí propojení:#No FileName FileSize FileSystem OpenClose QueryTable
1 CSV001000.csv 38kB 0,016 0,586 0,113
2 CSV010000.csv 416kB 0,152 0,672 0,277
3 CSV017000.csv 737kB 0,258 0,734 0,410
4 CSV035625.csv 1 592kB 0,535 0,906 0,770
5 CSV071250.csv 3 227kB 1,070 1,223 1,465
6 CSV142500.csv 6 663kB 2,164 1,902 2,863
7 CSV285000.csv 13 760kB 4,531 3,504 5,727
8 CSV570000.csv 27 955kB 9,875 7,199 11,836Otevřen soubor, kde je spuštěn kód a soubor, který obsahuje tisíce výpočtů a navíc tisíce externích propojení:#No FileName FileSize FileSystem OpenClose QueryTable
1 CSV001000.csv 38kB 0,016 1,531 0,266
2 CSV010000.csv 416kB 0,148 1,594 0,426
3 CSV017000.csv 737kB 0,258 1,633 0,559
4 CSV035625.csv 1 592kB 0,531 1,770 0,926
5 CSV071250.csv 3 227kB 1,063 2,086 1,637
6 CSV142500.csv 6 663kB 2,180 2,820 3,094
7 CSV285000.csv 13 760kB 4,328 4,391 6,219
8 CSV570000.csv 27 955kB 9,949 8,156 12,102Otevřen soubor, kde je spuštěn kód, soubor, který obsahuje tisíce výpočtů a navíc tisíce externích propojení a ještě další obrovský soubor s výpočty a kontingenčními tabulkami:#No FileName FileSize FileSystem OpenClose QueryTable
1 CSV001000.csv 38kB 0,012 1,629 2,148
2 CSV010000.csv 416kB 0,148 1,742 2,309
3 CSV017000.csv 737kB 0,258 1,816 2,449
4 CSV035625.csv 1 592kB 0,539 1,980 2,801
5 CSV071250.csv 3 227kB 1,066 2,328 3,520
6 CSV142500.csv 6 663kB 2,184 2,988 4,887
7 CSV285000.csv 13 760kB 4,340 4,570 7,930
8 CSV570000.csv 27 955kB 9,910 8,301 13,801
Jen technická poznámka. Pokud se to otevírá přímo v excelu, ptám se zda je vůbec nutné to ukládat a potom znovu otevírat. Není lepší pracovat s otevřeným sešitem?. Něco podobného dělám já - v SAP si otevřu sestavu v excel layout, nic neukládám a rovnou pracuji s daty.
Případně bych musel tabulku převést zpět na rozsah, dle potřeby doplnit sloupce, výpočtové a na data a pak zase zpět převést na tabulku.
Nemusíte převádět na rozsah - klikněte pravým tlačítkem a můžete odstranit nebo vložit sloupce
A vždy musí být sloupce s daty a pak až následovat sloupce s výpočty.
ano - vzorce nakonec
To makro lze takto připravit jen pro *.csv nebo to lze připravit i pro *.xml?
Lze téměř cokoliv...
Ale to už nechám na někom jiném
jen technická
začátek si upravte takto - kdybyste měnil adresář, uděláte to na jednom místě Dim sDir As String
sDir = ThisWorkbook.Path & "\DATA\"
Dim sFileTemp As String
sFileTemp = Dir(sDir & "\*.csv")
Dim sFile As String, dFileTime As Date
While Not sFileTemp = vbNullString
If FileDateTime(sDir & sFileTemp) > dFileTime Then
sFile = sDir & sFileTemp
End If
sFileTemp = Dir
Wend
Vy ale nevkládáte ta data na list makra ale na jiný list. Patří tam název listu, kde je ta tabulka.
MístoWith ActiveSheet.ListObjects("DataTab").DataBodyRangedejteWith Worksheets("NazevListu").ListObjects("DataTab").DataBodyRange
Nicméně při exportu z účetního SW začínají data o řádku 3, protože je tam v prvním řádku nějaká info, jen v jedné buňce a v druhém řádku jsou záhlaví sloupců.
Nejsem si jistý, jestli dobře rozumím. Pro soubor s info+záhlaví nahraďte
vValues = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Valueza
vValues = .Offset(2, 0).Resize(.Rows.Count - 2, .Columns.Count).Value
sFileTemp = Dir(ThisWorkbook.Path & "\DATA\*.csv")a pak ještě nahradit oba výskytyThisWorkbook.Path & "\" & sFileTempzaThisWorkbook.Path & "\DATA\" & sFileTemp
Mno a když už si tak povídám ))
Závity jsem pocvičil, se svým řešením jsem spokojen. Nicméně nejjednodušší prostě bude csv otevřítSub subImportCSV()
Dim sFileTemp As String
sFileTemp = Dir(ThisWorkbook.Path & "\*.csv")
Dim sFile As String, dFileTime As Date
While Not sFileTemp = vbNullString
If FileDateTime(ThisWorkbook.Path & "\" & sFileTemp) > dFileTime Then
sFile = ThisWorkbook.Path & "\" & sFileTemp
End If
sFileTemp = Dir
Wend
If Not sFile = vbNullString Then
Dim bScreen As Boolean
bScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
Workbooks.OpenText Filename:=sFile, DataType:=xlDelimited, Semicolon:=True, Local:=True
With ActiveWorkbook
With .Worksheets(1).UsedRange
Dim vValues As Variant
vValues = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Value
End With '.Worksheets(1).UsedRange
.Close False
End With 'ActiveWorkbook
With ActiveSheet.ListObjects("DataTab").DataBodyRange
If .Rows.Count > 1 Then
.Offset(1, 0).EntireRow.Delete
End If
.Cells(1).Resize(UBound(vValues, 1), UBound(vValues, 2)).Value = vValues
End With 'ActiveSheet.ListObjects("DataTab").DataBodyRange
Application.ScreenUpdating = bScreen
Else
MsgBox ("Neexistuje žiadny .csv súbor.")
End If
End Sub
Vymáčkl jste se dobře, ale uložil jste jako 7z.
Použijte Automatický filtr - vyfiltrujte 0, data označte a vyberte pouze viditelné (ALT+;), klepněte pravým tlačítkem a dejte odstranit celý řádek. Pak zrušte filtr.
@Alfan
pokud exportujete soubor do xml a následně ho ručně transforujete na csv přičemž csv pak importujete kódem, nechte kód, ať to udělá za Vás ;)
Tak změna - hned jak jsem to odeslal, tak mně napadlo jak odbourat druhý cyklus ;)
samotné načtení a zápis dat trvá u mně cca 2 s, zbytek času si bere excel na doplnění vzorců, kalkulace atd
Sub subImportCSV()
Dim sFileTemp As String
sFileTemp = Dir(ThisWorkbook.Path & "\*.csv")
Dim sFile As String, dFileTime As Date
While Not sFileTemp = vbNullString
If FileDateTime(ThisWorkbook.Path & "\" & sFileTemp) > dFileTime Then
sFile = ThisWorkbook.Path & "\" & sFileTemp
End If
sFileTemp = Dir
Wend
If Not sFile = vbNullString Then
Dim sText As String
With CreateObject("Scripting.FileSystemObject").OpenTextFile(sFile)
sText = .ReadAll
.Close
End With 'CreateObject("Scripting.FileSystemObject").OpenTextFile(sFile)
Dim iRows As Long
iRows = (Len(sText) - Len(Replace(sText, vbCrLf, vbNullString))) / 2
With CreateObject("Scripting.FileSystemObject").OpenTextFile(sFile)
Dim vValues() As Variant
ReDim vValues(iRows, UBound(Split(.ReadLine, ";"))) 'záhlaví
Dim iRow As Long, iColumn As Long
iRow = -1
Dim sLine As String
While Not .AtEndOfStream
iRow = iRow + 1
sLine = .ReadLine
For iColumn = 0 To UBound(vValues, 2)
vValues(iRow, iColumn) = Split(sLine, ";")(iColumn)
Next iColumn
Wend
.Close
End With 'CreateObject("Scripting.FileSystemObject").OpenTextFile(sFile)
With ActiveSheet.ListObjects("DataTab").DataBodyRange
If .Rows.Count > 1 Then
.Offset(1, 0).EntireRow.Delete
End If
.Cells(1).Resize(UBound(vValues, 1) + 1, UBound(vValues, 2) + 1).Value = vValues
End With 'ActiveSheet.ListObjects("DataTab").DataBodyRange
Else
MsgBox ("Neexistuje žiadny .csv súbor.")
End If
End Sub
@elninoslov
s tím nejnovějším datem je to dobrý nápad
zběžně jsem koukal na Váš kód - jak píšete chce to ještě doladit
používáte fso pro zjištění nejnovějšího souboru - tady to není potřeba, stačí použít Dir + FileDateTime
Dal jsem si ranní rozcvičku
Pokud si uvědomíme, že csv je textový soubor, pro načtení dat bych naopak fso použil - stejně jako u Vás soubor není třeba otevřít, nevytvářím žádný dočasný list ale hlavně dodržuji zásadu co nejmenšího počtu přístupů na list - vše dělám v kódu a to jej značně zrychluje. Na list tak přistupuji pouze 2x - mazání starých dat a zápis nových (přímo do tabulky)
Ve Vašem kódu navíc něco způsobuje resize tabulky (rozšířil jsem ji o 3 sloupce a stále se vrací na 7)
Bohužel se mi nepovedlo (zatím) vymyslet, jak to udělat v jednom cyklu, proto jsem musel jet cykly 2 a využít dočasné pole.
V csv souboru jsem přidal záhlaví (které předpokládám) a rozšířil ho na 142831 řádků a 4 sloupce. Myslel jsem si že budu kvůli druhému cyklu delší než Vy, ale zas tak hrozné to není - můj kód jel 16s a Váš 13. Pokud by v něm byly další listy se vzorci, bude se to patrně přiklánět na stranu mého řešení.
Neberte jako kritiku, ale jako diskusi ;)
Sub subImportCSV()
Dim sFileTemp As String
sFileTemp = Dir(ThisWorkbook.Path & "\*.csv")
Dim sFile As String, dFileTime As Date
While Not sFileTemp = vbNullString
If FileDateTime(ThisWorkbook.Path & "\" & sFileTemp) > dFileTime Then
sFile = ThisWorkbook.Path & "\" & sFileTemp
End If
sFileTemp = Dir
Wend
If Not sFile = vbNullString Then
Dim vValuesTemp() As Variant
ReDim vValuesTemp(0)
With CreateObject("Scripting.FileSystemObject").OpenTextFile(sFile)
.ReadLine 'záhlaví
While Not .AtEndOfStream
If Not IsEmpty(vValuesTemp(0)) Then
ReDim Preserve vValuesTemp(UBound(vValuesTemp) + 1)
End If
vValuesTemp(UBound(vValuesTemp)) = Split(.ReadLine, ";")
Wend
.Close
End With 'CreateObject("Scripting.FileSystemObject").OpenTextFile(sFile)
Dim vValues() As Variant
ReDim vValues(UBound(vValuesTemp), UBound(vValuesTemp(0)))
Dim i As Long, j As Long
For i = 0 To UBound(vValues, 1)
For j = 0 To UBound(vValues, 2)
vValues(i, j) = vValuesTemp(i)(j)
Next j
Next i
With ActiveSheet.ListObjects("DataTab").DataBodyRange
If .Rows.Count > 1 Then
.Offset(1, 0).EntireRow.Delete
End If
.Cells(1).Resize(UBound(vValues, 1) + 1, UBound(vValues, 2) + 1).Value = vValues
End With 'ActiveSheet.ListObjects("DataTab").DataBodyRange
Else
MsgBox ("Neexistuje žiadny .csv súbor.")
End If
End Sub
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