Text dosyası oluşturmak.

[Leoncio]

Arkadaşlar merhaba;

Ekte örneğini verdiğim dosya ile c:\ içinde txt dosyası oluşturuyorum. Konu ile ilgili 2 soruma yardımlarınızı bekliyorum.

1- Mevcut makro ile txt dosyası oluşturulurken Excel A ve E sütunundaki verileri alıyor ben A,C,E sütundaki verileri txt dosyasına aldırmak istiyorum. (B sütunu alınmayacak)
2- Txt dosyasındaki açıklamamda belirttiğim gibi üst başlıkta
KLMKRCMUGMUL20070114 şeklinde olmalı yani KLMKRCMUGMUL sabit 200701 Excel dosyasındaki d2 hücresinden alacak 14 ise excel dosyasının satır sayısından alacak.

Kodlarda ne gibi revize yapmam gerekiyor? veya alternatif kodlar ne olabilir?

 

[Levent Menteşoğlu]

Mevcut kodlarınızda revizyon yaparak çözüm bulmak elbette mümkün ama ben size farklı bir çözüm öneriyorum.

Sub textecevir()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Dene").Copy Before:=Sheets(1)
[a1] = "KLMKRCMUGMUL" & Right([d2], 4) & Mid([d2], 7, 2) & WorksheetFunction.CountA(Range("A10:A10000"))
[d2] = ""
Rows("3:9").Delete
[b3:b65536].Delete
[c3:c65536].Delete
[a:c].ColumnWidth = 3
ActiveSheet.Copy
ActiveWorkbook.SaveAs "C:\DE350.txt", FileFormat:=xlTextPrinter
ActiveWorkbook.Close True
ActiveSheet.Delete
MsgBox "Belgeniz c:\DE350.txt Dosyasına Yazılmıştır."
End Sub

 

[veyselemre]

Sub Txtyap()
Dim veri1 As String * 15
Dim veri2 As String * 10
Dim i As Integer
Dim veri0

son = [A65536].End(3).Row
veri0 = "KLMKRCMUGMUL" & Right([D2], 4) & Mid([D2], 7, 2) & son - 9

Open "c:\DE350.txt" For Output As #1

Print #1, veri0 & vbCrLf

For i = 10 To son
        veriA = Cells(i, 1)
        If Cells(i, 3) = "" Then veri2 = 0 Else veriC = Cells(i, 3)
        
        mc = Cells(i, 5)

        veriE = String(18 - Len(mc), "0") & mc & " "

    Print #1, veriA, veriC, veriE
Next i
Close #1
MsgBox "Belgeniz c:\DE350.txt Dosyasına Yazılmıştır."
End Sub

 

[Leoncio]

Arkadaşlar teşekkürler. Levent hocam;

1-Kodlarda D sütunu txt dosyasına aktarılmamış.
2 Verdiğiniz kodlarda dijit aralıklarını 34 yapmak istiyorum. Örnek olarak iliştirdiğim excel tablosunun orjinali 6500 satırdan oluşuyor. Yani txt dosyasındaki A,C,D,E sütunundaki mesaje 34 dijit olarak ayarlanmalı.

2-Verdiğiniz kodlarda sadece a ve e kolonunu almak istersem kodlarda ne gibi değişiklik yapmalıyım? (Öğrenmek açısından)

 

[Levent Menteşoğlu]

1-İlk mesajınızda A,C ve E sütunları aktarılacak demişsiniz. D sütununuda katmak için kod içindeki aşağıdaki satırı silin.

[c3:c65536].Delete

2- Aralığı ayarlamak için "[a:c].ColumnWidth = 3" satırındaki 3 değerini değiştirebilirsiniz.

3-Sadece A ve E için kodu aşağıdaki gibi kullanabilirsiniz.

Sub textecevir()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Dene").Copy Before:=Sheets(1)
[a1] = "KLMKRCMUGMUL" & Right([d2], 4) & Mid([d2], 7, 2) & WorksheetFunction.CountA(Range("A10:A10000"))
[d2] = ""
[e10:e65536] = [e10:e65536].Value
Rows("3:9").Delete
[b3:d65536].Delete
[a:c].ColumnWidth = 3
ActiveSheet.Copy
ActiveWorkbook.SaveAs "C:\DE350.txt", FileFormat:=xlTextPrinter
ActiveWorkbook.Close True
ActiveSheet.Delete
MsgBox "Belgeniz c:\DE350.txt Dosyasına Yazılmıştır."
End Sub

 

[Leoncio]

Hocam;

Değerli açıklamalarınız için çok teşekkür ederim. Kodlarınızı anca test edebildim. Ellerinize sağlık.

Edıt: Son bir sorum olabilir mi? Excel çalışma sayfasında 6312 satırlık tablo içinde boş hücreler var. Bunları Txt dosyasına atarken 0 (sıfır) yazarak atabilir mi?