• DİKKAT

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

Exceldeki veriler ile Text dosyası yaratmak...

B

batuhangs

Katılım
9 Aralık 2006
Mesajlar
41
Excel Vers. ve Dili
Office 2003
Herkese selamlar..
Arkadaşlar şöyle birşeye ihtiyacım var.. Ekteki excel dosyasını .txt formatında kaydetmem lazım.. Asıl önemli olan formatı.. Text olduğunda excel'deki tüm veriler yanyana olucak, aralarda hiç boşluk olmayacak.. Mesela ilk satır ;
135001912200711019100TRY0000555555000000000010000000000015000000000020000000000025000000000030000000000035000000000040000000000045

Dosyanın altında hangi kolonun kaç karakter olacağı yazıyor.. Karakter sayısına tamamlayacak kadar başlarına sıfır gelecek.. Dosyayı masaüstüne ya da C'nin altında bir yere atabilir..
Acil yardımlarınızı bekliyorum dostlar..:hihoho: :hihoho: :hihoho:
 
Ekli dosyayı inceleyiniz butona basınız C:\Dosya.txt dosyası yaratılıyor ve istediğiniz formatta aktarılıyor.
Verilerinizin çokluğuna göra makronun çalışması uzun olabilir.
Kolay gelsin.:cool:
Kod: 
Sub txt_dosya()
Dim bsut As Integer, cgun As String, cay As String, cyil As String, tarih As String
Dim dsut As String, esut As String, fsut As String, gsut As String, hsut As String
Dim isut As String, jsut As String, ksut As String, lsut As String, msut As String
Dim nsut As String, sonuc As String

'Dosya Oluşturulup Açılıyor
Sheets("KAMU").Select
'Open "C:\Belgelerim\deneme1.txt" For Append As #2
Open "C:\Dosya.txt" For Output As #1
For i = 4 To Cells(65536, "B").End(xlUp).Row
    bsut = Format(Cells(i, "B").Value, "000")
    cgun = Format(Day(Cells(i, "C").Value), "00")
    cay = Format(Month(Cells(i, "C").Value), "00")
    cyil = Format(Year(Cells(i, "C").Value), "0000")
    tarih = "00" & cgun & cay & cyil
    dsut = Format(Cells(i, "D").Value, "00000000")
    esut = Format(Cells(i, "E").Value, "000")
    fsut = Format(Cells(i, "F").Value, "000000000000")
    gsut = Format(Cells(i, "G").Value, "000000000000")
    hsut = Format(Cells(i, "H").Value, "000000000000")
    isut = Format(Cells(i, "I").Value, "000000000000")
    jsut = Format(Cells(i, "J").Value, "000000000000")
    ksut = Format(Cells(i, "K").Value, "000000000000")
    lsut = Format(Cells(i, "L").Value, "000000000000")
    msut = Format(Cells(i, "M").Value, "000000000000")
    nsut = Format(Cells(i, "N").Value, "000000000000")
    sonuc = bsut & tarih & dsut & esut & fsut & gsut & hsut _
    & isut & jsut & ksut & lsut & msut & nsut
    Write #1, sonuc
Next
Close #1
MsgBox "C Kök dizininde Dosya.txt dosyası yaratıldı ,ve aktarıldı", vbOKOnly + vbInformation, "AKTARMA"
End Sub
 
Alternatif olarak aşağıdaki kodun kullanıldığı ekli dosyayı inceleyin. C:\denemex.txt isimli bir dosya oluşturur.

Kod, mevcut verileri dosyaya eklediği yeni bir sayfa üzerinde istediğiniz şekilde düzenledikten sonra bu sayfanın text dosyası olarak kaydedilmesi prensibine göre çalışmaktadır.

Kod: 
Sub textecevir()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set s1 = Sheets("KAMU")
Sheets.Add After:=Sheets(Sheets.Count)
For a = 4 To s1.[b65536].End(3).Row
tarih = Format(Day(s1.Cells(a, "c")) & Format(Month(s1.Cells(a, "c")), "00") & Year(s1.Cells(a, "c")), "0000000000")
For b = 6 To 14
vade = vade & Format(s1.Cells(a, b), "000000000000")
Next
Cells(a - 3, "a") = Format(s1.Cells(a, "b"), "000") & tarih & Format(s1.Cells(a, "d"), "00000000") & _
s1.Cells(a, "e") & vade
vade = ""
Next
ActiveSheet.Copy
ActiveWorkbook.SaveAs "C:\denemex.txt", FileFormat:=xlTextPrinter
ActiveWorkbook.Close True
Sheets(Sheets.Count).Delete
End Sub
 
leventm' Alıntı:
Alternatif olarak aşağıdaki kodun kullanıldığı ekli dosyayı inceleyin. C:\denemex.txt isimli bir dosya oluşturur.

Kod, mevcut verileri dosyaya eklediği yeni bir sayfa üzerinde istediğiniz şekilde düzenledikten sonra bu sayfanın text dosyası olarak kaydedilmesi prensibine göre çalışmaktadır.

Kod: 
Sub textecevir()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set s1 = Sheets("KAMU")
Sheets.Add After:=Sheets(Sheets.Count)
For a = 4 To s1.[b65536].End(3).Row
tarih = Format(Day(s1.Cells(a, "c")) & Format(Month(s1.Cells(a, "c")), "00") & Year(s1.Cells(a, "c")), "0000000000")
For b = 6 To 14
vade = vade & Format(s1.Cells(a, b), "000000000000")
Next
Cells(a - 3, "a") = Format(s1.Cells(a, "b"), "000") & tarih & Format(s1.Cells(a, "d"), "00000000") & _
s1.Cells(a, "e") & vade
vade = ""
Next
ActiveSheet.Copy
ActiveWorkbook.SaveAs "C:\denemex.txt", FileFormat:=xlTextPrinter
ActiveWorkbook.Close True
Sheets(Sheets.Count).Delete
End Sub
Genişletmek için tıkla ...



yardımınız için çok teşekkürler ama sadece ilk satırı yapıyor..
diğer satırları neden yapmıyor?
 
Orion2' Alıntı:
Ekli dosyayı inceleyiniz butona basınız C:\Dosya.txt dosyası yaratılıyor ve istediğiniz formatta aktarılıyor.
Verilerinizin çokluğuna göra makronun çalışması uzun olabilir.
Kolay gelsin.:cool:
Kod: 
Sub txt_dosya()
Dim bsut As Integer, cgun As String, cay As String, cyil As String, tarih As String
Dim dsut As String, esut As String, fsut As String, gsut As String, hsut As String
Dim isut As String, jsut As String, ksut As String, lsut As String, msut As String
Dim nsut As String, sonuc As String

'Dosya Oluşturulup Açılıyor
Sheets("KAMU").Select
'Open "C:\Belgelerim\deneme1.txt" For Append As #2
Open "C:\Dosya.txt" For Output As #1
For i = 4 To Cells(65536, "B").End(xlUp).Row
    bsut = Format(Cells(i, "B").Value, "000")
    cgun = Format(Day(Cells(i, "C").Value), "00")
    cay = Format(Month(Cells(i, "C").Value), "00")
    cyil = Format(Year(Cells(i, "C").Value), "0000")
    tarih = "00" & cgun & cay & cyil
    dsut = Format(Cells(i, "D").Value, "00000000")
    esut = Format(Cells(i, "E").Value, "000")
    fsut = Format(Cells(i, "F").Value, "000000000000")
    gsut = Format(Cells(i, "G").Value, "000000000000")
    hsut = Format(Cells(i, "H").Value, "000000000000")
    isut = Format(Cells(i, "I").Value, "000000000000")
    jsut = Format(Cells(i, "J").Value, "000000000000")
    ksut = Format(Cells(i, "K").Value, "000000000000")
    lsut = Format(Cells(i, "L").Value, "000000000000")
    msut = Format(Cells(i, "M").Value, "000000000000")
    nsut = Format(Cells(i, "N").Value, "000000000000")
    sonuc = bsut & tarih & dsut & esut & fsut & gsut & hsut _
    & isut & jsut & ksut & lsut & msut & nsut
    Write #1, sonuc
Next
Close #1
MsgBox "C Kök dizininde Dosya.txt dosyası yaratıldı ,ve aktarıldı", vbOKOnly + vbInformation, "AKTARMA"
End Sub
Genişletmek için tıkla ...



yardımn için çok teşekkürler, süper olmuş..
ama başındaki ve sonundaki tırnak işaretlerini nasıl kaldırabiliriz..
 
batuhangs' Alıntı:
yardımn için çok teşekkürler, süper olmuş..
ama başındaki ve sonundaki tırnak işaretlerini nasıl kaldırabiliriz..
Genişletmek için tıkla ...
Txt dosyasına verileri string değer olarak aktardım.O yüzden tırnak işaretleri mecburen oluyor.Oradan okumak istediğinizde val komutunu kullanarak string değeri nümeric değere çevirebilirsiniz.
İyi çalışmalar.:cool:
 
Dostlarım;
ikinizide saygıyla selamlıyorum..
Yardımlarınız için çok ama çok teşekkürler..
Sağlıcakla kalın..
 
batuhangs' Alıntı:
Dostlarım;
ikinizide saygıyla selamlıyorum..
Yardımlarınız için çok ama çok teşekkürler..
Sağlıcakla kalın..
Genişletmek için tıkla ...

Rica ederim.
İyi çalışmalar.:cool:
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst