< návrat zpět

MS Excel


Téma: Export do TXT rss

Zaslal/a 18.9.2014 14:51

Zdar borci,
potřebuju makrem vyexportovat obsah tabulky do texťáku, ale tahle:
"hodnota1" "hodnota2" "hodnota3"
"hodnota3" "hodnota4" "hodnota5"

Takže každá hodnota musí být uzavřena do úvozovek a mezi nimi mezera, žádné čárky ani středníky

Povedlo se mi to zatím jenom takhle:
"hodnota1 hodnota2 hodnota3"
"hodnota4 hodnota5 hodnota6"
anebo takhle:
"hodnota1"" ""hodnota2"" ""hodnota3"
"hodnota4"" ""hodnota5"" ""hodnota6"

Ale ani jedno neni ono.
Prosím o help.
Milan

Použil jsem tenhle kód:

Sub ExportTXT1()

Dim ExpRng As Range
Dim FirstCol As Integer, LastCol As Integer, FirstRow As Integer, LastRow As Long, r%, c%
Dim Hodnota As String, strTXT As String

Range("A2").Activate

'zjisti hranice oblasti pro export
Set ExpRng = ActiveCell.CurrentRegion
FirstCol = ExpRng.Columns(1).Column
LastCol = FirstCol + ExpRng.Columns.Count - 1
FirstRow = ExpRng.rows(1).Row
LastRow = FirstRow + ExpRng.rows.Count - 1


'otevri
Open ThisWorkbook.Path & "\Text_CSV2.txt" For Output As #1

' 'exportuj po radcich
' For r = FirstRow To LastRow
' For c = FirstCol To LastCol
' Hodnota = ExpRng.Cells(r, c).Value
'
' If c = FirstCol Then
' strTXT = Hodnota & Chr(34)
' Else
' If c < LastCol Then
' strTXT = strTXT & " " & Chr(34) & Hodnota & Chr(34)
' Else
' strTXT = strTXT & " " & Chr(34) & Hodnota
' End If
' End If
' If c = LastCol Then Write #1, strTXT
'
' Next c
' Next r


'exportuj po radcich
For r = FirstRow To LastRow
For c = FirstCol To LastCol
Hodnota = ExpRng.Cells(r, c).Value

If c = FirstCol Then
strTXT = Hodnota
Else
If c < LastCol Then
strTXT = strTXT & " " & Hodnota
Else
strTXT = strTXT & " " & Hodnota
End If
End If
If c = LastCol Then Write #1, strTXT

Next c
Next r

Close #1
End Sub

Zaslat odpověď >

#021609
avatar
Použij druhou variantu a funkci nahradit
toto: " "
nahraď pouze mezeroucitovat
#021610
avatar
To nahradit myslíš jako pak v tom notepadu?
No, má to být pro denodenní aktualizaci databáze a toto by byla ruční operace navíc, která, pokud by se zapomněla provést, tak nevím, co by to mohlo v té DB způsobit.

Upřednostnil bych, kdyby to šlo komplet vytvořit ve VBA, ale přesto dík za řešení. Pokud neobjevíme čistější způsob, tak se to asi bude muset dělat takhlecitovat
#021611
Hav-Ran
Mám v archíve toto, kedy sa predpokladá uloženie v rovnakom adresári, oblasť je určená používaná :

Sub SaveAsTXT()
Dim Range As Object, Line As Object, Cell As Object
Dim StrTemp As String

Dim Separateur As String

Separateur = " "
Set Range = ActiveSheet.UsedRange
'ak nie je zadaná cesta, uloží podľa nastavenia Excelu -
'Nástroje - Možnosti - Obecné - výchozí umístení souboru !!
Open "Text_CSV2.txt" For Output As #1
For Each Line In Range.Rows
StrTemp = ""
For Each Cell In Line.Cells
StrTemp = StrTemp & CStr _
(Cell.Text) & Separateur
Next
Print #1, StrTemp '= " "
Next
Close
End Subcitovat
#021612
avatar
Ahoj Igor,

vďaka za snahu, ten textový výstup je oddelený medzerami, so far so good.
Ale ďalšou podmienkou je že každá hodnota ešte musí byť "obalená" úvodzovkami.
To je ten problém, nad ktorým si lámem hlavu.
M.citovat
#021613
avatar
skuste toto makro: je to na 10riadkoux10stlpcou
Příloha: zip21613_test.zip (14kB, staženo 30x)
citovat
#021614
avatar
Úžasné!!!
To je presne ono. Tie textové konvencie sú niekedy nepochopiteľné. Zopakujem riešenie:

Sub aStart()

Dim record As String
Open ActiveWorkbook.Path & "\test.txt" For Output As #1
For x = 1 To 10
record = Empty
For y = 1 To 10
record = record & """" & Cells(x, y) & """ "
Next
Print #1, record
Next
Close #1

End Sub

Ďakujem Paloovicitovat

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