txt den veri alma ve veri kaydetme

Katılım
8 Temmuz 2008
Mesajlar
57
Excel Vers. ve Dili
excell 2007
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.
 

Ekli dosyalar

Zeki Gürsoy

Uzman
Uzman
Katılım
31 Aralık 2005
Mesajlar
4,376
Excel Vers. ve Dili
Office 365 (64 bit) - Türkçe
Boş bir module yapıştırıp deneyin.

Kod:
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
 
Katılım
8 Temmuz 2008
Mesajlar
57
Excel Vers. ve Dili
excell 2007
ü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.
 
Katılım
8 Temmuz 2008
Mesajlar
57
Excel Vers. ve Dili
excell 2007
sayın zeki üstadım daha yardımcı olursanız memnun olurum. teşekkürler
 

Zeki Gürsoy

Uzman
Uzman
Katılım
31 Aralık 2005
Mesajlar
4,376
Excel Vers. ve Dili
Office 365 (64 bit) - Türkçe
Dosya açılırken hata oluştuğundan kaydederken "zaten açık" uyarısı vermekte.
Kodu müsait zamanda revize edeceğim.
 

Zeki Gürsoy

Uzman
Uzman
Katılım
31 Aralık 2005
Mesajlar
4,376
Excel Vers. ve Dili
Office 365 (64 bit) - Türkçe
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.
 
Katılım
15 Ocak 2009
Mesajlar
257
Excel Vers. ve Dili
Türkçe 2010
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.
 

Ekli dosyalar

Zeki Gürsoy

Uzman
Uzman
Katılım
31 Aralık 2005
Mesajlar
4,376
Excel Vers. ve Dili
Office 365 (64 bit) - Türkçe
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.

Kod:
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
 
Katılım
14 Ekim 2011
Mesajlar
3
Excel Vers. ve Dili
Home Bussines 2010
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.
 

Ekli dosyalar

Mehmet Şahin

Destek Ekibi
Destek Ekibi
Katılım
13 Ekim 2005
Mesajlar
1,406
Excel Vers. ve Dili
Excel 2010 - 2013 Türkçe - İngilizce
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.
 
Son düzenleme:
Katılım
14 Ekim 2011
Mesajlar
3
Excel Vers. ve Dili
Home Bussines 2010
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.
 

Ekli dosyalar

Mehmet Şahin

Destek Ekibi
Destek Ekibi
Katılım
13 Ekim 2005
Mesajlar
1,406
Excel Vers. ve Dili
Excel 2010 - 2013 Türkçe - İngilizce
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)

Kod:
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
 
Son düzenleme:
Katılım
14 Ekim 2011
Mesajlar
3
Excel Vers. ve Dili
Home Bussines 2010
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 Auto_Open() ile sağladım.Şu an grafik çizme ile uğraşıyorum.
 

Ekli dosyalar

Son düzenleme:

Mehmet Şahin

Destek Ekibi
Destek Ekibi
Katılım
13 Ekim 2005
Mesajlar
1,406
Excel Vers. ve Dili
Excel 2010 - 2013 Türkçe - İngilizce
İşinize yaradığına sevindim. İyi çalışmalar...
 
Üst