< návrat zpět

MS Excel


Téma: Export kontingenční tabulka - csv nebo xlsx rss

Zaslal/a 5.9.2022 13:06

AlfanDobrý den,
můžete mi, prosím, pomoct vytvořit makro, které by uložilo kontingenční tabulku z:
1) aktivního listu
2) nebo z konkrétního listu (zeditoval bych přímo v makru) do souboru *.csv a druhá varianta do *.xlsx

Ale potřebuji, aby v obou výstupech byly zachovány formáty tak, jak je vidíme v té KT.
To pole HS je textové a potřebuji tam 100% ty nuly vpředu.

Další formátování ani v tom *.xlsx souboru nepotřebuji a ani nechci. Tím myslím grafiku.
Děkuji.
Radek

Příloha: zip53321_wall-export-kt.zip (27kB, staženo 10x)
Zaslat odpověď >

icon #053346
eLCHa
Dám vám odpověď, kterou nechcete slyšet (číst) ;) : Power Query

Do přílohy jsem nekoukal.
Nevytvářejte KT, kterou pak budete exportovat.
Vytvořte nový soubor, kde pomocí pover query nasimulujete výsledek té vaší KT. Pak máte rovnou výsledek v jednom z formátů, který jste chtěl - xlsx.
Automaticky obnovitelný stejně jako KT a bez VBA a hlavně - sám si ho vytvoříte.citovat
#053347
Alfan
Děkuji 1

Já občas s Power Query narazím na to, že kolegové nemají dostatečnou verzi Office a pak jim například nejde spustit aktualizace souboru, kde je PQ, protože nemají Power pivot.

A nevím, zda se to dá nějak obejít.citovat
#053393
avatar
PQ je jestli si dobře pamatuju možné stáhnout jako doplněk do excelu od verze 2010
určitě to jde dohledatcitovat
#053396
elninoslov
Makro riešenie na KT-only
Sub Export_KT_do_XLSX()
Dim WB As Workbook

Set WB = Workbooks.Add

ThisWorkbook.Worksheets("přehled").PivotTables("Kontingenční tabulka1").TableRange2.Copy 'kopíruj oblast KT

With WB.Worksheets(1).Cells(1, 1)
.PasteSpecial xlPasteColumnWidths 'přilepit šířky sloupců
.PasteSpecial xlPasteValues 'přilepit hodnoty
.PasteSpecial xlPasteFormats 'přilepit formáty
.Select
End With

Application.CutCopyMode = False

WB.SaveAs ThisWorkbook.Path & "\přehled-export.xlsx", xlOpenXMLWorkbook 'uložit soubor XLSX
WB.Close False

Set WB = Nothing
End Sub
Sub Export_KT_do_CSV()
Dim S As Integer, R As Long, i As Long, y As Long, Sirky() As Double, T As String

Const DELIMITER = ";"

With ThisWorkbook.Worksheets("přehled").PivotTables("Kontingenční tabulka1").TableRange2 'pro oblast KT
S = .Columns.Count
R = .Rows.Count

ReDim Sirky(1 To S)

For i = 1 To S 'odložit původní šířky KT sloupců
Sirky(i) = .Columns(i).ColumnWidth
Next i

.EntireColumn.AutoFit 'upravit šířky na zobrazení celých hodnot

For i = 1 To R
For y = 1 To S
T = T & IIf(y > 1, DELIMITER, "") & .Cells(i, y).Text 'poskládej výsledné zobrazení v buňkách jako text
Next y
T = T & vbNewLine
Next i

For i = 1 To S 'vrátit původní šířky KT sloupců
.Columns(i).ColumnWidth = Sirky(i)
Next i
End With

S = FreeFile
Open ThisWorkbook.Path & "\přehled-export.csv" For Output As #S
Print #S, T 'zápis textového souboru CSV
Close #S
End Sub
Příloha: zip53396_wall-export-kt.zip (33kB, staženo 4x)
citovat
#053409
Alfan
Děkuji za rady a za makra 1
Radekcitovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

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.

Aktivní diskuse

Hromadné přepsání

elninoslov • 24.5. 10:29

Hromadné přepsání

Nomi • 24.5. 8:32

Index - každý rok začít od 1 Power Query

Alfan • 23.5. 9:17

nepřímý odkaz

elninoslov • 23.5. 0:00

nepřímý odkaz

bordov • 22.5. 18:35

vrácené hodnoty

Anonym • 22.5. 15:46

vrácené hodnoty

Anonym • 22.5. 15:45