MS Excel

Dobrý 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

Zaslat odpověď >

eLCHa(8.9.2022 7:58)#053346

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

Alfan(8.9.2022 13:03)#053347

Děkuji

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

veny(13.9.2022 13:52)#053393

PQ je jestli si dobře pamatuju možné stáhnout jako doplněk do excelu od verze 2010
určitě to jde dohledatcitovat

elninoslov(13.9.2022 16:38)#053396

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 SubSub 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: zip

53396_wall-export-kt.zip (33kB, staženo 5x)

citovat

Alfan(14.9.2022 14:12)#053409

Děkuji za rady a za makra

Radekcitovat

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

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje