Excel den .txt (Metin Belgesi) dosyasına kayıt

A

asas44

Katılım
13 Temmuz 2013
Mesajlar
121
Excel Vers. ve Dili
2013 excel
Elimdeki excel dosyasında binlerce satır veri var, her 900 satırı bir .txt (Metin Belgesi) dosyasına kaydetmek istiyorum. Örneğin ilk 900 satırı 1. .txt (Metin Belgesi) dosyasına arkasından gelen ikinci 900 satırı 2. .txt (Metin Belgesi) dosyasına arkasından gelen üçüncü 900 satırı 3. .txt (Metin Belgesi) dosyasına ..... kaydedecek bu .txt (Metin Belgesi) dosyalarını kendi açıp yazıp kaydedecek mümkünmüdür acaba ?
 
Emir Hüseyin Çoban

Emir Hüseyin Çoban

Destek Ekibi
Destek Ekibi
Katılım
11 Ağustos 2008
Mesajlar
5,892
Excel Vers. ve Dili
Office 2013 Tr - Win10 x64
. . .

Bir kaç satırlık excel ve txt dosyası örneği yükleyebilir misiniz.

. . .
 
A

asas44

Katılım
13 Temmuz 2013
Mesajlar
121
Excel Vers. ve Dili
2013 excel
Emir Hüseyin bey exceldeki ilk 900 satırı alıp 1 tane metin belgesi açıp içine kaydedip kapatacak sonra o aldığı 900 satırdan sonraki gelen 1800 satırın kalan 900 satırını alıp 2. metin belgesini açıp içine kaydedip çıkacak bu mantıkta son veriye kadar inecek diyelim 90.300 satırlık bir excelde 90 tane metin belgesi açarak kayıt yaptı son 300 satırıda alıp son metin belgesine kaydedip çıkacak ve işlemi bitirecek. (Exceldeki sütun sayısı farketmez 2 sütundanda oluşabilir veri, 5 sütundanda, 1 sütundanda)
Örnek dosya: https://drive.google.com/open?id=0B6EbKfe08n2gSDRlcWkydkEwc0U
 
Emir Hüseyin Çoban

Emir Hüseyin Çoban

Destek Ekibi
Destek Ekibi
Katılım
11 Ağustos 2008
Mesajlar
5,892
Excel Vers. ve Dili
Office 2013 Tr - Win10 x64
.

Excel listede
Arada boş satır olabilir mi.

.
 
Ö

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,997
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
Merhaba.

Sayın ÇOBAN'ın müsadeleriyle. Hazırlamıştım, göndereyim dedim.

Aşağıdaki kod'u kullanabilirsiniz.

Kod excel belgesinin bulunduğu klasöre, 900 satırlık herbir bölümü bir txt olarak kaydeder.

-- Verinizin sütun sayısına göre kırmızı işaretlediğim kısma benzer şekilde gerekli ilaveyi yapın.
-- dosya adının başlangıç kısmını, isteğinize göre değiştirin,
-- kod, oluşturulan txt belgeyi, vereceğiniz bu ismin sonuna 1, 2, 3 ... gibi sayı ekleyerek adlandırır.
.
Kod: 
[B]Sub txt_BRN()[/B]
Set s1 = Sheets("Sayfa1"): s1.Activate
yol = ThisWorkbook.Path & "\": adı = "[B][COLOR="Blue"]asas44_BRN_[/COLOR][/B]"
adet = WorksheetFunction.RoundUp(s1.Cells(Rows.Count, 1).End(3).Row / 900, 0)
For brn = 1 To adet
    sayı = sayı + 1: ilk = (brn - 1) * 900 + 1: son = ilk + 899
    If son > s1.Cells(Rows.Count, 1).End(3).Row Then son = s1.Cells(Rows.Count, 1).End(3).Row
        Open yol & adı & sayı & ".txt" For Output As #1
            For i = ilk To son
                Print #1, Cells(i, "A")[B][COLOR="Red"]; vbTab; Cells(i, "B")[/COLOR][/B]
            Next i
        Close #1
Next
MsgBox "Bu belgenin bulunduğu klasöre, gerekli TXT belgeler oluşturuldu. ", , "..::.. Ö. BARAN ..::.."
[B]End Sub[/B]
 
halit3

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,853
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Alternatif kod

Kod: 
Sub deneme()
son = 900
say = 0
For i = 1 To Cells(Rows.Count, "B").End(3).Row
yaz = ""
For j = 1 To Cells(i, Columns.Count).End(xlToLeft).Column ' yan sütün sayısı
yaz = yaz & RightPadChar(Cells(i, j), " ", 8) 'boşlu sayısı
Next j

If say = son Or say = 0 Then
sayi = CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path).Files.Count 'klasördeki dosya sayısı
kayit = ThisWorkbook.Path & "\dosya" & sayi & ".txt"
say = 0
'Open kayit For Output As #1
Open kayit For Append As #1
End If

Print #1, yaz

If say = son - 1 Then
Close #1
End If

say = say + 1
Next i
Close #1
MsgBox "işlem tamam"
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
 
A

asas44

Katılım
13 Temmuz 2013
Mesajlar
121
Excel Vers. ve Dili
2013 excel
Ömer Hocam elinize sağlık Halit hocam şimdi gördüm sizin koduda emeklerinize sağlık
 
A

ark123

Katılım
26 Aralık 2006
Mesajlar
39
Excel Vers. ve Dili
excell 2005
asas44' Alıntı:
Elimdeki excel dosyasında binlerce satır veri var, her 900 satırı bir .txt (Metin Belgesi) dosyasına kaydetmek istiyorum. Örneğin ilk 900 satırı 1. .txt (Metin Belgesi) dosyasına arkasından gelen ikinci 900 satırı 2. .txt (Metin Belgesi) dosyasına arkasından gelen üçüncü 900 satırı 3. .txt (Metin Belgesi) dosyasına ..... kaydedecek bu .txt (Metin Belgesi) dosyalarını kendi açıp yazıp kaydedecek mümkünmüdür acaba ?
Genişletmek için tıkla ...
Mümkündür.
dosyanı gönder yardım edeyim.
 
A

asas44

Katılım
13 Temmuz 2013
Mesajlar
121
Excel Vers. ve Dili
2013 excel
Ömer BARAN' Alıntı:
Merhaba.

Sayın ÇOBAN'ın müsadeleriyle. Hazırlamıştım, göndereyim dedim.

Aşağıdaki kod'u kullanabilirsiniz.

Kod excel belgesinin bulunduğu klasöre, 900 satırlık herbir bölümü bir txt olarak kaydeder.

-- Verinizin sütun sayısına göre kırmızı işaretlediğim kısma benzer şekilde gerekli ilaveyi yapın.
-- dosya adının başlangıç kısmını, isteğinize göre değiştirin,
-- kod, oluşturulan txt belgeyi, vereceğiniz bu ismin sonuna 1, 2, 3 ... gibi sayı ekleyerek adlandırır.
.
Kod: 
[B]Sub txt_BRN()[/B]
Set s1 = Sheets("Sayfa1"): s1.Activate
yol = ThisWorkbook.Path & "\": adı = "[B][COLOR="Blue"]asas44_BRN_[/COLOR][/B]"
adet = WorksheetFunction.RoundUp(s1.Cells(Rows.Count, 1).End(3).Row / 900, 0)
For brn = 1 To adet
    sayı = sayı + 1: ilk = (brn - 1) * 900 + 1: son = ilk + 899
    If son > s1.Cells(Rows.Count, 1).End(3).Row Then son = s1.Cells(Rows.Count, 1).End(3).Row
        Open yol & adı & sayı & ".txt" For Output As #1
            For i = ilk To son
                Print #1, Cells(i, "A")[B][COLOR="Red"]; vbTab; Cells(i, "B")[/COLOR][/B]
            Next i
        Close #1
Next
MsgBox "Bu belgenin bulunduğu klasöre, gerekli TXT belgeler oluşturuldu. ", , "..::.. Ö. BARAN ..::.."
[B]End Sub[/B]
Genişletmek için tıkla ...
Hocam göndermiş olduğunuz macro yu çalıştırıyorum dosyadaki verileri .txt dosyalarına parçalıyor doğru bir şekilde fakat .txt dosyalarına girdiğim zaman verilerin başına ve sonuna boşluklar bırakıyor. Boşluk sorunuda kalkarsa tam süper olacak. Şimdiden elinize sağlık
https://www.dosyaupload.com/hWSX
 
halit3

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,853
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
asas44' Alıntı:
Hocam göndermiş olduğunuz macro yu çalıştırıyorum dosyadaki verileri .txt dosyalarına parçalıyor doğru bir şekilde fakat .txt dosyalarına girdiğim zaman verilerin başına ve sonuna boşluklar bırakıyor. Boşluk sorunuda kalkarsa tam süper olacak. Şimdiden elinize sağlık
https://www.dosyaupload.com/hWSX
Genişletmek için tıkla ...

Birde bu kodu denermisiniz.

Kod: 
Sub deneme()
son = 900
say = 0
For i = 1 To Cells(Rows.Count, "[COLOR="Red"]a[/COLOR]").End(3).Row
yaz = ""
For j = 1 To Cells(i, Columns.Count).End(xlToLeft).Column ' yan sütün sayısı
yaz = yaz & RightPadChar(Cells(i, j), " ", [COLOR="Red"]11[/COLOR]) 'boşlu sayısı
Next j

If say = son Or say = 0 Then
sayi = CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path).Files.Count 'klasördeki dosya sayısı
kayit = ThisWorkbook.Path & "\dosya" & sayi & ".txt"
say = 0
'Open kayit For Output As #1
Open kayit For Append As #1
End If

Print #1, yaz

If say = son - 1 Then
Close #1
End If

say = say + 1
Next i
Close #1
MsgBox "işlem tamam"
End Sub
 
halit3

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,853
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
kodun diğer bölümünü eklememişim kodun tamamı bu

Kod: 
Sub deneme()
son = 900
say = 0
For i = 1 To Cells(Rows.Count, "a").End(3).Row
yaz = ""
For j = 1 To Cells(i, Columns.Count).End(xlToLeft).Column ' yan sütün sayısı
yaz = yaz & RightPadChar(Cells(i, j), " ", 11) 'boşlu sayısı
Next j

If say = son Or say = 0 Then
sayi = CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path).Files.Count 'klasördeki dosya sayısı
kayit = ThisWorkbook.Path & "\dosya" & sayi & ".txt"
say = 0
'Open kayit For Output As #1
Open kayit For Append As #1
End If

Print #1, yaz

If say = son - 1 Then
Close #1
End If

say = say + 1
Next i
Close #1
MsgBox "işlem tamam"
End Sub


[COLOR="Red"]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[/COLOR]
 
halit3

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,853
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
sadece tek sutün yazdıracaksanız kod

Kod: 
Sub deneme()
son = 900
say = 0
For i = 1 To Cells(Rows.Count, "a").End(3).Row

If say = son Or say = 0 Then
sayi = CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path).Files.Count 'klasördeki dosya sayısı
kayit = ThisWorkbook.Path & "\dosya" & sayi & ".txt"
say = 0
Open kayit For Append As #1
End If
Print #1, Mid(Cells(i, 1), 1, Len(Cells(i, 1)))

If say = son - 1 Then
Close #1
End If
say = say + 1
Next i
Close #1
MsgBox "işlem tamam"
End Sub
 
A

asas44

Katılım
13 Temmuz 2013
Mesajlar
121
Excel Vers. ve Dili
2013 excel
Halit3 hocam çok teşekkürler elinize sağlık gayet iyi çalışıyor şuan
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst