• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

MS Excel

Téma: Export do TXT

Zaslal/a Milan-D 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ěď >

---

zEjnik(18.9.2014 17:15)#021609

Použij druhou variantu a funkci nahradit
toto: " "
nahraď pouze mezeroucitovat

Milan-D(18.9.2014 21:44)#021610

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

Hav-Ran(19.9.2014 4:23)#021611

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

Milan-D(19.9.2014 9:28)#021612

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

Palooo(19.9.2014 10:57)#021613

skuste toto makro: je to na 10riadkoux10stlpcou

Příloha: 21613_test.zip (14kB, staženo 35x)

citovat

Milan-D(19.9.2014 11:23)#021614

Úž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)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse