• DİKKAT

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

Txt veri aktarma Hk.

Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
T

talebeyim

Katılım
25 Aralık 2007
Mesajlar
300
Excel Vers. ve Dili
2007 tr
Hayırlı günler.

-x.xls isimli bir dosya içerisine koyulacak bir buton vasıtasiyle aynı klasör içerisinde bulunan bir metin dosyasina veri aktarmak istiyorum...

metin dosyasinin adı yazi.txt oluşturmak istediğim metin. aşağıdaki gibidir. parantez içerisinde alanlar hücre adresleridir. bu hücrelerdeki verileri buraya yazmak istiyorum. Diğer metinler sabittir.



4 K(G5)t E(G6)t İ(G7)t S.:
6 K(O5)t E(O6)t İ(O7)t S.:
B K(Y5)t E(Y6)t İ(Y7)t S.:
K K(AE5)t E(AE6)t İ(AE7)t S.:
S K(AI5)t E(AI6)t İ(AI7)t S.:
T K(AO5)t E(AO6)t İ(AO7)t S.:
A K(AS5)t E(AS6)t İ(AS7)t S.:
 
önceki dosyayı siler yeni dosya oluşturyr ve verileri yazar.
Dosyanız ektedir.:cool:
Kod: 
Sub txtaktar59()
Dim i As Long, sat As Long
sat = Cells(Rows.Count, "A").End(xlUp).Row
Open (ThisWorkbook.Path & "\Yazi.txt") For Output As #1
For i = 1 To sat
    Write #1, Cells(i, "A").Value
Next
Close #1
MsgBox "Yazi.txt dosyası ayni klasöre oluşturuldu." & vbLf & _
    "evrengizlen@hotmail.com", vbOKOnly + vbInformation
End Sub
 

Ekli dosyalar

Orion1 sorumla yazdığınız kodların ne alakası var Allah icin ?
 
Sanırım sorumu dikkatli okumadınız. yukarıda diyorumki benim bir excel tablom var. O tabloda parantez içerisindeki yazanlar. Hücrelerin adresleridir. bu hucreye yazılan seyler metinde yer alacak.
diğer metinler zaten sabit simdi anlatabildimmi ????????
 
Merhaba,

Alternatif olarak aşağıdaki kodu deneyiniz.

Kod: 
Option Explicit
 
Sub Düğme1_Tıklat()
    Dim Dosya, Veri
    Dosya = ThisWorkbook.Path & "\yazi.txt"
    
    Open Dosya For Append As #1
        Print #1, "4 K" & Range("G5") & "t E" & Range("G6") & "t İ" & Range("G7") & "t S.:"
        Print #1, "6 K" & Range("O5") & "t E" & Range("O6") & "t İ" & Range("O7") & "t S.:"
        Print #1, "B K" & Range("Y5") & "t E" & Range("Y6") & "t İ" & Range("Y7") & "t S.:"
        Print #1, "K K" & Range("AE5") & "t E" & Range("AE6") & "t İ" & Range("AE7") & "t S.:"
        Print #1, "S K" & Range("AI5") & "t E" & Range("AI6") & "t İ" & Range("AI7") & "t S.:"
        Print #1, "T K" & Range("AO5") & "t E" & Range("AO6") & "t İ" & Range("AO7") & "t S.:"
        Print #1, "A K" & Range("AS5") & "t E" & Range("AS6") & "t İ" & Range("AS7") & "t S.:"
    Close #1
    
    MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation
End Sub
 
Hocam Allah razi olsun ya, Yemin olsun, bu gece forma neredeyse son girişimdi, bir haftada 5-6 konu açtım neredeyse hiçbirinden sonuç alamadım, çoğunda bir çizik bile yok.
Allah senden razi olsun nokta atışı yaptın.
 
Txt ye getirdiğim değeri. 59,80 ise 59800 olarak geliyor bunu nasıl ondalığa çevirebilirim ?
 
Merhaba,

Örnek dosya ile hatalı işlemi açıklarmısınız.
 
Yok korhan bey hatalı bir işlem falan yok, yukarıda excelden txt'ye veri alma kodlarını yazdınızya, işte excelden rakamları aktarırken ondalık rakamları metin olarak aktarıyor. ben bu rakamları yine ondalıklı aktarmasını istiyorum.
 
Merhaba,

Ben denediğimde ondalıklı olarak atıyor. Sizin bölgesel ayarlarınız farklı ayarlanmış olabilir mi?
 
Denedim ama olmadı

yeni bölge ayarlarına baktım fakat tüm ayarlar Türkçe .
ben size ekteki dosyayı gönderiyorum buyrun birde bunu deneyin. hatta txtde bende cıkan sonucuda gönderiyorum.
 

Ekli dosyalar

talebeyim' Alıntı:
yeni bölge ayarlarına baktım fakat tüm ayarlar Türkçe .
ben size ekteki dosyayı gönderiyorum buyrun birde bunu deneyin. hatta txtde bende cıkan sonucuda gönderiyorum.
Genişletmek için tıkla ...

Sorularınıza bende bakmıştım.
Ama tam olarak ne istediğinizi anlıyamadımdan cevap vermemiştim.oysa son mesajınızdaki örnekler gibi dosyalarınızı manuel olması gerektiği gibi ekleseydiniz muhakkakki cevap alırdınız.

Yukarıdaki sorunuza gelince dosyanızda ki hücrelerde görünen noktalar aslında metin olarak baktığınızda yani hücrenin içindeyken formül çubuğuna baktığınızda bu noktalar yok onun için kod bu noktaları aktarım yaparken dikkate almaz.

O zaman bunları istenen formata çevirmek gerekiyor binlik olarak böyle yapmanız gerekiyor.
Kod: 
Print #1, "4 K" & Format(Range("B1"), "#,###") & "t E" & Range("B2") & "t İ" & Format(Range("B3"), "#,###") & "t S.:"

Binlik ve kuruşlu olarakda böyle yapmanız gerekiyor.

Kod: 
 Print #1, "4 K" & Format(Range("B1"), "#,###.00") & "t E" & Range("B2") & "t İ" & Format(Range("B3"), "#,###.00") & "t S.:"

Sadece kuruşlu yapmak için de böyle yapmak gerekiyor.
Kod: 
 Print #1, "4 K" & Format(Range("B1"), "#.00") & "t E" & Range("B2") & "t İ" & Format(Range("B3"), "#.00") & "t S.:"

Ayrıca text dosyasında alt alta yazmak için kodun ilgili bölümü böyle olmalı

Open Dosya For Append As #1

Silerek yazmak içinde bunu kullanmak gerek.

Open Dosya For Output As #1
 
Halit bey cok tesekkür ederim anlatım tarzınızın yanında, sanki " -şundanda haberiniz olsun" dercesine verdiğiniz örnekler gerçekten çok güzel oluyor.

Peki ben bir şey daha sormak istiyorum. Txt ye aktaracağım veri 59.500 ve 600 bunları alt alta aktardığımda şöyle oluyor;
59.000
600
Peki ben bunları sağ tarafa dayalı şekilde export edemezmiyim txtye?

böyle yapabilirsem aktardıktan sonra txt okunaklı oluyor. ve Ayrıca txtde aktarırken bazı kelimeleri BOLD" /k " yapabilirmiyim ?
 
talebeyim' Alıntı:
Halit bey cok tesekkür ederim anlatım tarzınızın yanında, sanki " -şundanda haberiniz olsun" dercesine verdiğiniz örnekler gerçekten çok güzel oluyor.

Peki ben bir şey daha sormak istiyorum. Txt ye aktaracağım veri 59.500 ve 600 bunları alt alta aktardığımda şöyle oluyor;
59.000
600
Peki ben bunları sağ tarafa dayalı şekilde export edemezmiyim txtye?

böyle yapabilirsem aktardıktan sonra txt okunaklı oluyor. ve Ayrıca txtde aktarırken bazı kelimeleri BOLD" /k " yapabilirmiyim ?
Genişletmek için tıkla ...

Yapmak istediğin şeye ait örnek dosyanızı ekleyin ve olması gereken text dosyasına ait verileri kendiniz manuel olarak yazın ve örnek olarak ekeleyin buraya bir bakalım.

BOLD için bir şey diyemiyeceğim bildiğim kadarı ile text dosyasında böyle bir olay yok.
 
Bağışlayın çok haklısınız halit bey buyrun,




Halit bey eğer musaitseniz cevap beklediğim ADO ile ilgili bir konum var onada bakabilirseniz...


Teşekkür ederim.
 

Ekli dosyalar

talebeyim' Alıntı:
Bağışlayın çok haklısınız halit bey buyrun,




Halit bey eğer musaitseniz cevap beklediğim ADO ile ilgili bir konum var onada bakabilirseniz...


Teşekkür ederim.
Genişletmek için tıkla ...

Bu sorununuzu anlamadığım için cevap veremiyeceğim.
Diğer sorunuz ile ilgili;
kod;

Kod: 
Sub txt()
Dim Dosya, Veri
Dosya = ThisWorkbook.Path & "\yazili.txt"
Open Dosya For Output As #1
For i = 2 To Cells(Rows.Count, "B").End(3).Row
If i = 2 Then
deg1 = LeftPadChar(Format(Cells(i, "b").Value, "##,#"), " ", 6) & "   El:"
deg2 = LeftPadChar(Format(Cells(i, "c").Value, "##,#"), " ", 6) & "   El:"
ElseIf i = 3 Then
deg1 = deg1 & LeftPadChar(Format(Cells(i, "b").Value, "##,#"), " ", 7) & "   İh:"
deg2 = deg2 & LeftPadChar(Format(Cells(i, "c").Value, "##,#"), " ", 7) & "   İh:"
ElseIf i = 4 Then
deg1 = deg1 & LeftPadChar(Format(Cells(i, "b").Value, "##,#"), " ", 5) & "Siparişler :"
deg2 = deg2 & LeftPadChar(Format(Cells(i, "c").Value, "##,#"), " ", 5) & "Siparişler :"
Else
If Cells(i, "b").Value <> "" Then
deg1 = deg1 & LeftPadChar(Cells(i, "b").Value, " ", 8) & "hop -   "
End If
If Cells(i, "c").Value <> "" Then
deg2 = deg2 & LeftPadChar(Cells(i, "c").Value, " ", 8) & "hop -   "
End If
End If
Next
Print #1, "42 : " & deg1
Print #1,
Print #1, "60 : " & deg2
Close #1
 
MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation
End Sub
Function RightPadChar(ByVal Astr As String, PadChar As String, stLen As Integer) As String
Dim AStrL As Integer
Astr = Trim(Astr)
AStrL = Len(Astr)
If AStrL < stLen Then
Astr = Astr + String(stLen - AStrL, PadChar)
Else
Astr = Mid$(Astr, 1, stLen)
End If
RightPadChar = Astr
End Function
Function LeftPadChar(ByVal Astr As String, PadChar As String, stLen As Integer) As String
Dim AStrL As Integer
Astr = Trim(Astr)
AStrL = Len(Astr)
If AStrL < stLen Then
Astr = String(stLen - AStrL, PadChar) + Astr
Else
Astr = Mid$(Astr, 1, stLen)
End If
LeftPadChar = Astr
End Function
 
Halit beyin yukarıda vermiş olduğu kodlara, birkaç eklenti yaparak kendime uyarladım, verdiği kodlar tam olarak işimi gördü.

Konum çözüme ulaştı.
Halit beye çok teşekkür ederim.
 
talebeyim' Alıntı:
Halit beyin yukarıda vermiş olduğu kodlara, birkaç eklenti yaparak kendime uyarladım, verdiği kodlar tam olarak işimi gördü.

Konum çözüme ulaştı.
Halit beye çok teşekkür ederim.
Genişletmek için tıkla ...

İyi çalışmalar
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Geri
Üst