txt istenilen satırların silinmesi

[aatoş]

merhabalar...
daha önceki denediğim macroyla txt lerin birleştirlmesi işlemini yapıyorum ama istenilen bilgide her txt dosyasındaki başlangıç ve bitiş satırlarının silinerek taşınmasını isteniliyor.bir macro örnegini(daha önce formunuzdan faydalandığım) aşağıda yazıyorum.bu macroda düzeltilerek bilgi verirseniz sevinirim.şimdiden emeği geçene teşekkürler..

Sub txt_birlestir()
Dim fso As Object, fs As Object, deg As String
Set fso = CreateObject("Scripting.filesystemobject")
Open (ThisWorkbook.Path & "\Evren.txt") For Output As #1
For Each fs In fso.getfolder(ThisWorkbook.Path).Files
If Right(fs.Name, 4) <> ".xls" And fs.Name <> "Evren.txt" Then
Open (ThisWorkbook.Path & "\" & fs.Name) For Input As #2


Do While Not EOF(2)
Line Input #2, deg
Print #1, deg
Loop

Close #2
End If
Next
Close #1

End Sub

 

[aatoş]

merhabalar...
daha önceki denediğim macroyla txt lerin birleştirlmesi işlemini yapıyorum ama istenilen bilgide her txt dosyasındaki başlangıç ve bitiş satırlarının silinerek taşınmasını isteniliyor.bir macro örnegini(daha önce formunuzdan faydalandığım) aşağıda yazıyorum.bu macroda düzeltilerek bilgi verirseniz sevinirim.şimdiden emeği geçene teşekkürler..

Sub txt_birlestir()
Dim fso As Object, fs As Object, deg As String
Set fso = CreateObject("Scripting.filesystemobject")
Open (ThisWorkbook.Path & "\Evren.txt") For Output As #1
For Each fs In fso.getfolder(ThisWorkbook.Path).Files
If Right(fs.Name, 4) <> ".xls" And fs.Name <> "Evren.txt" Then
Open (ThisWorkbook.Path & "\" & fs.Name) For Input As #2


Do While Not EOF(2)
Line Input #2, deg
Print #1, deg
Loop

Close #2
End If
Next
Close #1

End Sub[/QUOTE

sordugum bu sorunun cevabını hala alamadım(?) yeterince acaba anlaşılır mı yazamadım.daha önce yardımcı olan fikirlerinden faydalandığım arkadaşlardan (duayenlerden)hala bir cevap ve ilgi görmedim.!!!!!!!!!!!!!!

 

[Orion1]

Referanslardan Microsoft Scripting Runtime seçiniz.
Dosya adlarını ve yolunu kendinize göre ayarlayınız.
İlk ve son satırdaki verileri aktarmayıp diğer satırları aktarır.
Aşağıdaki kodlar işinizi görür.

Sub txt_aktar_59()
    'Microsoft Scripting Runtime Referansı Gerektirir
    Dim Kayit As Variant
    Dim FS As Object, Dosya As Object
    Set FS = CreateObject("Scripting.FileSystemObject")
    Set Dosya = FS.OpenTextFile(ThisWorkbook.Path & "\Kitap1.txt", ForReading)
    Kayit = Split(Dosya.ReadAll, vbCrLf, , vbTextCompare)
    Dosya.Close
    Open (ThisWorkbook.Path & "\Yeni dosya.txt") For Output As #1
    For i = LBound(Kayit) + 1 To UBound(Kayit) - 2
        Print #1, Kayit(i)
    Next
    Close #1
    MsgBox "Yeni txt dosyasına diğer dosyadan ilk ve son satır lar hariç akatrım yapıldı" & _
    vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[aatoş]

merhaba Evren Bey
ilginize (her zaman ki gibi) teşekkürler .daha öncede bu konuda sizden açıklayıcı bilgi almışdım)dediginiz gibi tool dan referance kısmından işaretledim ama bir hatadan (hatayı ben yapıyorum çünkü çok acemiyim macroda)ekli dosyaları yolluyorum.uygulayıp programı yolluyabilir misiniz?bu tarzda elimde çok sayıda txt dosyaları mevcut,şimdiden emeginize ve yüreginize sağlık teşekkürler kolay gelsin

 

[Orion1]

excel dosyanızın değiştirlecek olan txt dosyaları ile ayni klasörde olamsı lazım.
işte ben dosya adlarını düzelterek yaptım.Hata vermiyor .Dosyalarda aşağıda.

Sub txt_aktar_59()
    'Microsoft Scripting Runtime Referansı Gerektirir
    Dim Kayit As Variant
    Dim FS As Object, Dosya As Object
    Set FS = CreateObject("Scripting.FileSystemObject")
    Set Dosya = FS.OpenTextFile(ThisWorkbook.Path & "\Banka1.txt", ForReading)
    Kayit = Split(Dosya.ReadAll, vbCrLf, , vbTextCompare)
    Dosya.Close
    Open (ThisWorkbook.Path & "\Yeni dosya.txt") For Output As #1
    For i = LBound(Kayit) + 1 To UBound(Kayit) - 2
        Print #1, Kayit(i)
    Next
    Close #1
    MsgBox "Yeni txt dosyasına diğer dosyadan ilk ve son satır lar hariç akatrım yapıldı" & _
    vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[aatoş]

merhaba Evren bey..

elinize sağlık uğraşlarınız karşasında gerçekten samimiyetle söylüyorum yetersiz kalıyor bir teşekkür kelimesi.sitede emeği geçen tüm arkadaşlar için geçerli tabiki.
gönderdiginiz dosya benim içini tamamdır yalnız tek bir dosyada birleştirebilirmiyiz.(elimde bir çok txt dosyasını bu şekilde tek bir dosyaya da birleştirmek istiyorum da).elimden gelen sadece kuru bir teşekkür kalıyor . hakkınızı helal edin...emeginize sağlık....