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:
 
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
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
 
L

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
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
 
B

batuhangs

Katılım
9 Aralık 2006
Mesajlar
41
Excel Vers. ve Dili
Office 2003
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?
 
B

batuhangs

Katılım
9 Aralık 2006
Mesajlar
41
Excel Vers. ve Dili
Office 2003
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..
 
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
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:
 
B

batuhangs

Katılım
9 Aralık 2006
Mesajlar
41
Excel Vers. ve Dili
Office 2003
Dostlarım;
ikinizide saygıyla selamlıyorum..
Yardımlarınız için çok ama çok teşekkürler..
Sağlıcakla kalın..
 
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
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.
Üst