txt den veri alma ve veri kaydetme

[neromero]

saygıdeğer üstadlarım; ekte sunmuş olduğum txt dosyasında bulunan verileri excele alarak burada bazı alanlarda değişiklik yaparak tekrar txt dosyasında bu değişiklikleri güncellemek istiyorum. ama bunu yaparken boşluklar ve sıfırların sayısı çok önemli, txt i güncellerken aynı formatta ne bir boşluk fazla ne az, ne de bir sıfır fazla yada eksik olmamalı; bu konuda yardımlarınızı bekliyorum. şimdiden teşekkürler.

 

[Zeki Gürsoy]

Boş bir module yapıştırıp deneyin.

Sub TXT_Ac()
[COLOR=DarkGreen][B]' *** 18.04.2011 güncelleme ***[/B][/COLOR]
    Dim dosya As String, d As String
    Dim arr As Variant, c As Integer, s As Long
    
    Const SUT As Integer = 84
    
    On Error Resume Next
    
    dosya = Application.GetOpenFilename( _
            "Text Dosyaları (*.txt) (*.txt), *.txt", 1, _
            "::....... http://www.excel.web.tr......::")

    If dosya = "False" Then Exit Sub
    
    Range(Cells(1, 1), Cells(65536, SUT)).Columns.NumberFormat = "@"
    
    Open dosya For Input As #1
            
        While Not EOF(1)
            s = s + 1
            
            Line Input #1, d
            
            arr = Split(d, vbTab)
            
            For c = 0 To SUT
                Cells(s, c + 1) = arr(c)
            Next
            
        Wend
        
    Close #1
    
    MsgBox "Dosya alımı tamamlandı.", vbInformation, _
    "::....... http://www.excel.web.tr......::"
    
    If Err.Number <> 0 Then MsgBox Err.Description, vbExclamation, _
    "::....... http://www.excel.web.tr......::"
End Sub

Sub TXT_Kaydet()
    Dim dosya As String, m As Long, d As String
    Dim arr() As String, c As Integer
    
    Const SUT As Integer = 84
    
    dosya = Application.GetSaveAsFilename("", _
            "Text Dosyaları (*.txt) (*.txt), *.txt", 1, _
            "::....... http://www.excel.web.tr......::")
    
    If dosya = "False" Then Exit Sub
    
    On Error Resume Next
    
    ReDim arr(1 To SUT) As String
    
    Open dosya For Output As #1
    
        For m = 1 To Range("a65536").End(xlUp).Row
            
            For c = 1 To SUT
                arr(c) = Cells(m, c)
            Next
            
            d = Join(arr, vbTab)
            
            Print #1, d
            
        Next
        
    Close #1
    
    MsgBox "Dosya kaydı tamamlandı.", vbInformation, _
    "::....... http://www.excel.web.tr......::"
    
    If Err.Number <> 0 Then MsgBox Err.Description, vbExclamation, _
    "::....... http://www.excel.web.tr......::"
End Sub

 

[neromero]

üstadım teşekkür ederim çalışıyor ama daha fazla bilgi olan txt okuttuğumda subscript out of range dedi . kaydederken ise file already open dedi. teşekkür ederim.

 

[neromero]

sayın zeki üstadım daha yardımcı olursanız memnun olurum. teşekkürler

 

[Zeki Gürsoy]

Dosya açılırken hata oluştuğundan kaydederken "zaten açık" uyarısı vermekte.
Kodu müsait zamanda revize edeceğim.

 

[neromero]

tşk. bekliyorum üstadım.

 

[Zeki Gürsoy]

Yukarıdaki kod günceldir.

** Text verileriniz "Tab" ayraç ile 85 sütuna dağılıyor. Her bir sütunun uzunluğunu güncelleştirmenize göre kontrol ettirmedim. Bunu kontrol etmek sizin sorumluluğunuzda.

"Çek Tahsilatı" geçen sütundaki toplam uzunluk boşlukla beraber 50 olmasına rağmen boşluksuz olarak geri gönderdiğinizde (muhasebe prg. sanırım) size sıkıntı çıkaracağını sanmıyorum.

 

[unalh]

S.a Arkadaşlar,

Konuyla ilgili olduğu için devamına yazmak istedim eklediğim dosyada txt den
Plaka ve Tutar + KDV bölümlerini ListViev'e direk nasıl alabiliriz.

İlginize şimdiden teşekkür ederim.

 

[Zeki Gürsoy]

S.a Arkadaşlar,

Konuyla ilgili olduğu için devamına yazmak istedim eklediğim dosyada txt den
Plaka ve Tutar + KDV bölümlerini ListViev'e direk nasıl alabiliriz.

İlginize şimdiden teşekkür ederim.

Merhaba,

Aşağıdaki kod sizin dosyanız için...

Listview nesnesine veri almada forumdaki örnek dosyalardan faydalanabilirsiniz.

Sub TXT_Ac()
[COLOR=DarkGreen][B]' *** 19.04.2011 güncelleme ***[/B][/COLOR]
    Dim dosya As String, d As String
    Dim arr As Variant, c As Integer, s As Long
    
    [B]Const SUT As Integer = 16[/B]
    
    On Error Resume Next
    
    dosya = Application.GetOpenFilename( _
            "Text Dosyaları (*.txt) (*.txt), *.txt", 1, _
            "::....... http://www.excel.web.tr......::")

    If dosya = "False" Then Exit Sub
   
    Open dosya For Input As #1
            
        While Not EOF(1)
            s = s + 1
            
            Line Input #1, d
            
            arr = Split(d, vbTab)
            
            For c = 0 To SUT
                Cells(s, c + 1) = arr(c)
            Next
            
        Wend
        
    Close #1
    
    MsgBox "Dosya alımı tamamlandı.", vbInformation, _
    "::....... http://www.excel.web.tr......::"
    
    If Err.Number <> 0 Then MsgBox Err.Description, vbExclamation, _
    "::....... http://www.excel.web.tr......::"
End Sub

Sub TXT_Kaydet()
[B][COLOR=DarkGreen]' *** 19.04.2011 güncelleme ***[/COLOR][/B]
    Dim dosya As String, m As Long, d As String
    Dim arr() As String, c As Integer
    
    [B]Const SUT As Integer = 16[/B]
    
    dosya = Application.GetSaveAsFilename("", _
            "Text Dosyaları (*.txt) (*.txt), *.txt", 1, _
            "::....... http://www.excel.web.tr......::")
    
    If dosya = "False" Then Exit Sub
    
    On Error Resume Next
    
    ReDim arr(1 To SUT) As String
    
    Open dosya For Output As #1
    
        For m = 1 To Range("a65536").End(xlUp).Row
            
            For c = 1 To SUT
                arr(c) = Cells(m, c)
            Next
            
            d = Join(arr, vbTab)
            
            Print #1, d
            
        Next
        
    Close #1
    
    MsgBox "Dosya kaydı tamamlandı.", vbInformation, _
    "::....... http://www.excel.web.tr......::"
    
    If Err.Number <> 0 Then MsgBox Err.Description, vbExclamation, _
    "::....... http://www.excel.web.tr......::"
End Sub

 

[edoruk]

merhaba dostlar

Kullandığım bir cihazdan RS-232 üzerinden hyperterminal ile ekte eklediğim TXT formatında veri alabiliyorum. bu veriyi bir makro ile excell dosyasına aktarmak ve bundan grafikli bir rapor oluşturmak istiyorum. verileri düzgün bir şekilde excell e aktarmak işimi büyük oranda çözecek, pratik olması açısından dışardan veri al seçeneği ile yapmaktansa , makro kullanmayı istiyorum. hangi verinin hangi hücreye gideceğini bilirsem hücrelere gelen verilerden grafik formülünü kendim yapabilirim.

yardımlarınız için şimdiden çok teşekkür ederim.

Forumdaki hazır kodları denedim ancak bir türlü düzenli bir format elde edemedim.

 

[Mehmet Şahin]

Merhaba,
eklediğiniz dosyadaki verinin, excel'e aktarılmış halini dosya olarak ekleyiniz. Buna göre bir çözüm üretebilmek daha kolay olacaktır. Kolay gelsin.

 

[edoruk]

Merhaba,
eklediğiniz dosyadaki verinin, excel'e aktarılmış halini dosya olarak ekleyiniz. Buna göre bir çözüm üretebilmek daha kolay olacaktır. Kolay gelsin.

dosya ektedir. Makro ile txt den excell e otomatik olarak düzenli bir şekilde atabilirsem. değişkenlere göre grafik oluşturup sorunumu halledebilirim. birde şu var, makro ile önceden grafik formülünü yazdığım dosyanın içine atmam gerekiyor.

 

[Mehmet Şahin]

Merhaba,
verdiğiniz dosyaya uygun şekilde verileri atan kod aşağıdadır. Hazıra konarak, Zeki üstadın kodlarıyla biraz oynadım. (Vermiş olduğunuz txt dosyasında sanki bir satır kaymış gibi)

Sub TXT_Ac()
    Dim dosya As String, d As String
    Dim s As Long
    Dim st,i As Integer
    
    On Error Resume Next
    
    dosya = Application.GetOpenFilename( _
            "Text Dosyaları (*.txt) (*.txt), *.txt", 1, _
            "::....... http://www.excel.web.tr......::")

    If dosya = "False" Then Exit Sub
    Open dosya For Input As #1
        While Not EOF(1)

            s = s + 1
            Line Input #1, d
                     st = 0
                     x = Split(d, " ")
                    For i = 0 To UBound(x)
                        st = st + 1
                        If x(i) = "" And i > 0 Then
                        st = st - 1
                        GoTo atla
                        End If
                        Cells(s, st) = x(i)
atla:
                    Next i
            
        Wend
    Close #1
    
    MsgBox "Dosya alımı tamamlandı.", vbInformation, _
    "::....... http://www.excel.web.tr......::"
    
    If Err.Number <> 0 Then MsgBox Err.Description, vbExclamation, _
    "::....... http://www.excel.web.tr......::"
End Sub

 

[edoruk]

Ellerinize sağlık. kod çok güzel çalışıyor. Koda dosya = "d:\astell2.txt" olarak ekleyip, otomatik olarak dosyadan almasını sağladım. excell dosyasının içine grafik formülünü de hazırladım ancak ecxell dosyasını açınca makroyu otomatik çalıştırmasını da Sub Autpen() ile sağladım.Şu an grafik çizme ile uğraşıyorum.

 

[Mehmet Şahin]

İşinize yaradığına sevindim. İyi çalışmalar...