excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: Uložení listu do txt
MS Excel
Téma: Uložení listu do txt 
Zaslal/a poldacr 8.7.2014 9:10
Dobrý den. Chci poprosit o radu. Mám tabulku (cca600 řádků), kterou potřebuji ve stejném formátu exportovat do txt pomocí makra. Pokoušel jsem se o to způsobem uložit jako nebo pomocí kopírování. Narazím na to, že se mi v txt rozhodí formátování jednoho sloupce (v excelu sloupec F) a tím i následující sloupce. Část tabulky přikládám. Předem děkuji za pomoc.
Příloha: 
20415_export.zip (8kB, staženo 15x)
20415_export.zip (8kB, staženo 15x)V excelu mám všechny sloupce zarovnané doprava, sloupec F je nastaven jako číslo s oddělením tisíců zarovnán taky doprava. Když provedu export, sloupce A-D jsou v pořádku se zarovnáním, sloupec F už ne. Přikládám txt soubor,kde jsem ručně upravil prvních asi 5 řádků do požadovaného formátu. Děkuji.
Příloha: 
20424_opis.txt (2kB, staženo 18x)
citovat20424_opis.txt (2kB, staženo 18x)Mno ono je to trochu problém. Ty čísla jsou samozřejmě zarovnaná doleva, to už vychází z podstaty txt souboru. Abyste je měl zarovnané vpravo, musíte před kratší čísla vložit tolik mezer, kolik chybí do nejdelšího čísla v daném sloupci (jestli rozumíte - kromě sloupce F jsou všechny hodnoty ve sloupci stejně dlouhé, proto jsou "zarovnané"). To by šlo, jenže problém je, že v některých buňkách máte formát text a v něm textové řetězce, v jiných buňkách zase číslo s formátem # ##0.
Pokud netrváte na oddělení tisíců, tak mi fungujeSub subExport()
Dim rCol As Range
For Each rCol In ActiveSheet.UsedRange.Columns
If Not Application.WorksheetFunction.CountIf(rCol, "<>") = 0 Then
rCol.NumberFormat = Application.WorksheetFunction.Rept("?", Evaluate("MAX(LEN(" & rCol.Address & "))"))
rCol.Value = rCol.Value
End If
Next rCol
Set rCol = Nothing
ActiveWorkbook.SaveAs Filename:="V:\Export.txt", FileFormat:=xlText, CreateBackup:=False
End Subcitovat
Pokud netrváte na oddělení tisíců, tak mi fungujeSub subExport()
Dim rCol As Range
For Each rCol In ActiveSheet.UsedRange.Columns
If Not Application.WorksheetFunction.CountIf(rCol, "<>") = 0 Then
rCol.NumberFormat = Application.WorksheetFunction.Rept("?", Evaluate("MAX(LEN(" & rCol.Address & "))"))
rCol.Value = rCol.Value
End If
Next rCol
Set rCol = Nothing
ActiveWorkbook.SaveAs Filename:="V:\Export.txt", FileFormat:=xlText, CreateBackup:=False
End Subcitovat
Formát # ##0 jsem nastavil proto, aby bylo viditelné oddělení tisíců, ale na tomto formátu nijak netrvám, tak pokud by se sjednotil formát, bylo by pak možné do sloupce F přidat mezery do nejdelšího čísla? Díkcitovat
...pokud by se sjednotil formát, bylo by pak možné do sloupce F přidat mezery do nejdelšího čísla?
Moc tomu dotazu nerozumím.
Dal jsem do procedury konstantu THOUSEP_COLS, do které oddělené čárkou napíšete písmena sloupců, kde chcete použít oddělovač tisíců.
U mně to funguje:Sub subExport()
Const THOUSEP_COLS As String = "F" 'e.g. "A,C,D"
Dim sThouSepCols As String
sThouSepCols = Replace(THOUSEP_COLS, " ", vbNullString)
sThouSepCols = Replace("," & THOUSEP_COLS & ",", ",", ":,$")
Dim rCol As Range, sFormat As String
For Each rCol In ActiveSheet.UsedRange.Columns
With rCol
If Not Application.WorksheetFunction.CountIf(.Cells, "<>") = 0 Then
sFormat = Application.WorksheetFunction.Rept("?", Evaluate("MAX(LEN(" & .Address & "))"))
If Not InStr(sThouSepCols, Left(.EntireColumn.Address, InStr(.EntireColumn.Address, ":"))) = 0 Then
sFormat = Trim(Left(sFormat, Len(sFormat) Mod 3) & Replace(Right(sFormat, 3 * (Len(sFormat) \ 3)), "???", " ???"))
End If
.NumberFormat = sFormat
.Value = .Value
End If
End With 'rCol
Next rCol
Set rCol = Nothing
ActiveWorkbook.SaveAs Filename:="V:\Export.txt", FileFormat:=xlText, CreateBackup:=False
End Subcitovat
Moc tomu dotazu nerozumím.
Dal jsem do procedury konstantu THOUSEP_COLS, do které oddělené čárkou napíšete písmena sloupců, kde chcete použít oddělovač tisíců.
U mně to funguje:Sub subExport()
Const THOUSEP_COLS As String = "F" 'e.g. "A,C,D"
Dim sThouSepCols As String
sThouSepCols = Replace(THOUSEP_COLS, " ", vbNullString)
sThouSepCols = Replace("," & THOUSEP_COLS & ",", ",", ":,$")
Dim rCol As Range, sFormat As String
For Each rCol In ActiveSheet.UsedRange.Columns
With rCol
If Not Application.WorksheetFunction.CountIf(.Cells, "<>") = 0 Then
sFormat = Application.WorksheetFunction.Rept("?", Evaluate("MAX(LEN(" & .Address & "))"))
If Not InStr(sThouSepCols, Left(.EntireColumn.Address, InStr(.EntireColumn.Address, ":"))) = 0 Then
sFormat = Trim(Left(sFormat, Len(sFormat) Mod 3) & Replace(Right(sFormat, 3 * (Len(sFormat) \ 3)), "???", " ???"))
End If
.NumberFormat = sFormat
.Value = .Value
End If
End With 'rCol
Next rCol
Set rCol = Nothing
ActiveWorkbook.SaveAs Filename:="V:\Export.txt", FileFormat:=xlText, CreateBackup:=False
End Subcitovat
Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.
RSS nejnovější články