• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Excel'den txt ye çevirme

D

diskriminant

Katılım
14 Kasım 2006
Mesajlar
16
Excel Vers. ve Dili
excel 2003
ABANA_60.xls şeklindeki excel dosyasının
1. satırı
TICKER PER DATE TIME HIGH LOW CLOSE VOLUME
2.satırdan itibaren ise
ABANA.E 60 07/14/1994 12:00:00 0.032 0.029 0.030 24827
ABANA.E 60 07/14/1994 16:30:00 0.033 0.030 0.032 45496
ABANA.E 60 07/15/1994 12:00:00 0.034 0.030 0.032 7535
ABANA.E 60 07/15/1994 16:30:00 0.033 0.030 0.032 14289 şeklinde.
.
.
.

Bu excel dosyasını ABANA_60.txt şekline aşağıdaki gibi hangi makro ile getiririm?
<TICKER>,<PER>,<DATE>,<TIME>,<HIGH>,<LOW>,<CLOSE>,<VOLUME>
ABANA.E,60,19940714,120000,0.032,0.029.0.030,24827
ABANA.E,60,19940714,163000,0.033,0.030,0.032,45496
ABANA.E,60,19940715,120000,0.034,0.030,0.032,7535
ABANA.E,60,19940715,163000,0.033,0.030,0.032,14289
.
.
. Yardımcı olacaklara çok teşekkür ederim.
 
A&#351;a&#287;&#305;daki kodlar&#305; deneyiniz.

Kod: 
Sub TxtKaydet()
Dim a, b, c, d, e, f, g, h As Variant
Application.ScreenUpdating = False
Range("A1").Select
son = Range("a1").End(xlDown).Row
yol = "C:\[COLOR=RED][B]XXXX[/B][/COLOR]\ABANA_60.TXT"
'***************************************************************
a = "<" & [a1] & ">"
b = "<" & [b1] & ">"
c = "<" & [c1] & ">"
d = "<" & [d1] & ">"
e = "<" & [e1] & ">"
f = "<" & [f1] & ">"
g = "<" & [g1] & ">"
h = "<" & [h1] & ">"
'***************************************************************
Open yol For Output As #1

Print #1, a; ",", b; ",", c; ",", d; ",", e; ",", f; ",", g; ",", h; ","

For i = 2 To son

Print #1, Cells(i, 1); ",", Cells(i, 2); ",", Cells(i, 3); ",", Cells(i, 4); ",", Cells(i, 5); ",", Cells(i, 6); ",", Cells(i, 7); ",", Cells(i, 8); ","

Next Satir

Close #1

MsgBox "Verileriniz " & yol & " Dosyas&#305;na Kaydedilmi&#351;tir."
Range("A2").Select
Application.ScreenUpdating = False
End Sub
 
Son düzenleme:
Kod: 
For Satir = 2 To son

Print #1, Cells(Satir , 1); ",", Cells(Satir , 2); ",", Cells(Satir , 3); ",", Cells(Satir , 4); ",", Cells(Satir , 5); ",", Cells(Satir , 6); ",", Cells(Satir , 7); ",", Cells(Satir , 8); ","

Next Satir

sn ripek şeklinde olmalı galiba:arkadas:
 
ini dosyasına da aynı şekilde atabilir miyiz?
katagorilendirme yapabilir miyiz?
 
Sn.excellium,

Uyar&#305;n&#305;z i&#231;in te&#351;ekk&#252;rler.Atlam&#305;&#351;&#305;m.

.ini dosyalar&#305; hakk&#305;nda pek bilgim yok.Denemek laz&#305;m.
 
sn ripek,
uğraşınız için teşekkür ederim.Makro tarihi 7/9/1994 iken 19940907 olarak yazmadı.Tarihi aynı bıraktı.Ayrıca tablodaki ondalık sayıları da değiştirdi.
 
Merhaba,

Bu Forum'daki ilk mesajım bu. Herkese selamlar. Alternatif bir çözüm de ben vereyim:
Sadece Istege_Uyarlanmis_Txt_Kaydet'i çalıştırın.

Kod: 
Sub Istege_Uyarlanmis_Txt_Kaydet()
    Dim IlkAyrac As String
    Dim SonAyrac As String
    Dim SonSatir As Long
    Dim h
    Dim M
    Dim S
    Set WF = WorksheetFunction
        IlkAyrac = "<"
        SonAyrac = ">"
        SonSatir = WF.CountA(Range("A:A"))
            Open "C:\ABANA_60.txt" For Output As #1
                For i = 1 To 1
                    Write #1, IlkAyrac & Cells(i, 1) & SonAyrac, _
                        IlkAyrac & Cells(i, 2) & SonAyrac, _
                        IlkAyrac & Cells(i, 3) & SonAyrac, _
                        IlkAyrac & Cells(i, 4) & SonAyrac, _
                        IlkAyrac & Cells(i, 5) & SonAyrac, _
                        IlkAyrac & Cells(i, 6) & SonAyrac, _
                        IlkAyrac & Cells(i, 7) & SonAyrac, _
                        IlkAyrac & Cells(i, 8) & SonAyrac
                Next i
                For i = 2 To SonSatir
                        If Len(Hour(Cells(i, 4))) = 1 Then
                            h = "0" & Hour(Cells(i, 4))
                        Else
                            h = Hour(Cells(i, 4))
                        End If
                            If Len(Minute(Cells(i, 4))) = 1 Then
                                M = "0" & Minute(Cells(i, 4))
                            Else
                                M = Minute(Cells(i, 4))
                            End If
                        If Len(Second(Cells(i, 4))) = 1 Then
                            S = "0" & Second(Cells(i, 4))
                        Else
                            S = Second(Cells(i, 4))
                        End If
                    Write #1, Cells(i, 1), _
                        Cells(i, 2), _
                        Right(WF.Substitute(Cells(i, 3), "/", ""), 4) _
                        & Left(WF.Substitute(Cells(i, 3), "/", ""), 2) _
                        & Mid(WF.Substitute(Cells(i, 3), "/", ""), 3, 2), _
                        h & M & S, _
                        Cells(i, 5), _
                        Cells(i, 6), _
                        Cells(i, 7), _
                        Cells(i, 8)
                Next i
            Close
    YerineKoy
End Sub

Kod: 
Sub YerineKoy()
    Dim DosyaSistemi
    Dim Txt_Dosyasi
    Dim Icerik As String
    Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
    Set Txt_Dosyasi = DosyaSistemi.OpenTextFile("C:\ABANA_60.txt", 1, 0)
    Icerik = Txt_Dosyasi.ReadAll
    Icerik = Application.WorksheetFunction.Substitute(Icerik, Chr(34), "")
    Txt_Dosyasi.Close
    Set Txt_Dosyasi = DosyaSistemi.OpenTextFile("C:\ABANA_60.txt", 2)
    Txt_Dosyasi.WriteLine Icerik
    Txt_Dosyasi.Close
End Sub
 
Kod: 
Sub Test()
    Dim NoA As Long, i As Long, LngFile As Long
    Dim FSO As Object
    Dim MyFile As String, StrFirstLine As String, StrInput As String
    If Dir("C:\TestFolder", vbDirectory) = Empty Then MkDir ("C:\TestFolder")
    MyFile = "C:\TestFolder\ABANA_60.txt"
    NoA = Cells(65536, 1).End(xlUp).Row
    Set FSO = CreateObject("Scripting.FileSystemObject")
    LngFile = FreeFile
    Open MyFile For Output As #LngFile
    For i = 1 To 8
        StrFirstLine = StrFirstLine & "<" & Cells(1, i) & ">" & Chr(44)
    Next
    Print #LngFile, Left(StrFirstLine, Len(StrFirstLine) - 1)
    For i = 2 To NoA
        StrInput = Cells(i, 1) & Chr(44) & Cells(i, 2) & Chr(44) & Format(Cells(i, 3), "yyyymmdd") & Chr(44) & Format(Cells(i, 4), "hhmmss") & Chr(44)
        For j = 5 To 8
            StrInput = StrInput & Cells(i, j) & Chr(44)
        Next
        Print #LngFile, Left(StrInput, Len(StrInput) - 1)
    Next
    Close #LngFile
    MsgBox MyFile & " dosyasini acabilirsiniz....."
    Set FSO = Nothing
End Sub
 
xls dosyas&#305;n&#305;n txt olarak farkl&#305; kaydedilmesi prensibine g&#246;re &#231;al&#305;&#351;an bir alternatifte ben &#246;nereyim. Sadece txt dosyas&#305;nda olu&#351;an " (t&#305;rnak) i&#351;aretlerinin olu&#351;mas&#305;n&#305; engelleyemedim (text dosyalar&#305; &#252;zerinde hi&#231; &#231;al&#305;&#351;ma yapmad&#305;m). Bu i&#351;aretin kald&#305;r&#305;lmas&#305; konusunda &#246;nerilerinizi bekliyorum. Sayfadaki yerle&#351;imin resimdeki gibi oldu&#287;u kabul edilmi&#351;tir.

sayfadayerlesim.JPG


Kod: 
Sub textecevir()
[a1] = "<" & [a1] & ">,<" & [b1] & ">,<" & [c1] & ">,<" & [d1] & ">,<" & [e1] & ">,<" & [f1] & ">,<" & [g1] & ">,<" & [h1] & ">"
For a = 2 To [a65536].End(3).Row
Cells(a, "a") = Cells(a, "a") & "," & Cells(a, "b") & "," & Format(Cells(a, "c"), "yyyymmdd") & "," & Format(Cells(a, "d"), "hhmmss") & "," & Cells(a, "e") & "," & Cells(a, "f") & "," & Cells(a, "g") & "," & Cells(a, "h")
Next
[b:h].ClearContents
ActiveSheet.Copy
ActiveWorkbook.SaveAs "C:\ABANA_60.txt", FileFormat:=xlTextPrinter
ActiveWorkbook.Close True
End Sub
 
leventm' Alıntı:
...Sadece txt dosyasında oluşan " (tırnak) işaretlerinin oluşmasını engelleyemedim (text dosyaları üzerinde hiç çalışma yapmadım). Bu işaretin kaldırılması konusunda önerilerinizi bekliyorum...
Genişletmek için tıkla ...

Başka bir yöntem için yukarıda verdiğim YerineKoy isimli makroyu da kullanabilirsiniz.
 
Merhaba Arkadaşlar
Haluk Hocamın kodları ile text dosyasına dönüştürme işlemi tamam fakat aralardakii virgüllerin Noktalı virgül ; şeklinde olması gerekiyor birraz uğraştım ama olmadı yardımcı olursanız memnun olurum
 
Sn. Haluk'un kodlarındaki 44 leri 59 ile değiştirin
 
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst