".txt" Dosyasından Dosya Adina Göre Veri Çekme Hk.

[isoo_34]

Merhaba arkadaşlar;
Ek de yüklemiş olduğum Excel’ e yine ek de olan data klasörümdeki “.txt “dosyalarından veri çekmem gerekiyor. Tek Kıstas Excel de bulunan ;

“1” nolu sayfaya ,sonu “1” ile biten txt verilerini,
“2” nolu sayfaya, sonu “2” ile biten txt verilerini,
“3” nolu sayfaya, sonu “3” ile biten txt verilerini,,
“4” nolu sayfaya, sonu “4” ile biten .txt verilerini çekmesi gerekmektedir.

Not: Sadece 4.nolu sayfadan txt verilerini çekerken .txt dosya isimlerinide çekmesi gerekmekte
Siz Değerli Üstatlar Yardım Ederseniz Sevinirim.

Data : http://s7.dosya.tc/server15/0ljrsh/data.rar.html
Excel : http://s7.dosya.tc/server15/0ljrsh/birlestir.xlsx.html

 

[isoo_34]

LİNKLERİ YANLI VERMİŞİM KUSURUMA BAKMAYIN YENİ GÜNCEL LİNKLER BURLAR
Data : http://s7.dosya.tc/server15/ei9n1l/data.rar.html
Excel : http://s7.dosya.tc/server15/ei9n1l/birlestir.xlsx.html

 

[veyselemre]

Yeterince test edip kullanın.

Sub veriCek()
    Dim FSO As Object, strFile As Object
    Dim i, tip, sat, ysat

    Set FSO = CreateObject("Scripting.FileSystemObject")

    For i = 1 To 4
        Sheets("" & i & "").Select
        Rows("2:" & Rows.Count).ClearContents
    Next i

    For Each strFile In FSO.GetFolder(ThisWorkbook.Path & "\Data").Files
        If LCase(FSO.GetExtensionName(strFile.Name)) = "txt" Then
            tip = Right(Replace(strFile.Name, ".txt", ""), 1)
            Sheets(tip).Select
            sat = Cells(Rows.Count, 1).End(3).Row + 1
            ysat = sat
            Set txt = FSO.OpenTextFile(strFile)
            If sat > 1 Then t = txt.ReadLine
            Do Until txt.AtEndOfStream
                t = Split(txt.ReadLine, vbTab)
                Cells(sat, 1).Resize(, UBound(t) + 1).Value = t
                sat = sat + 1
            Loop
            If tip = "4" Then Cells(ysat, UBound(t) + 2).Resize(sat - ysat, 1).Value = strFile.Name
        End If
        Columns.AutoFit
    Next strFile

    Set strFile = Nothing
    Set FSO = Nothing
End Sub

 

[isoo_34]

Teşekkür ederim ilginize Deneyip dönüş yapcam

 

[isoo_34]

Sub veriCek() Dim FSO As Object, strFile As Object Dim i, tip, sat, ysat Set FSO = CreateObject("Scripting.FileSystemObject") For i = 1 To 4 Sheets("" & i & "").Select Rows("2:" & Rows.Count).ClearContents Next i For Each strFile In FSO.GetFolder(ThisWorkbook.Path & "\Data").Files If LCase(FSO.GetExtensionName(strFile.Name)) = "txt" Then tip = Right(Replace(strFile.Name, ".txt", ""), 1) Sheets(tip).Select sat = Cells(Rows.Count, 1).End(3).Row + 1 ysat = sat Set txt = FSO.OpenTextFile(strFile) If sat > 1 Then t = txt.ReadLine Do Until txt.AtEndOfStream t = Split(txt.ReadLine, vbTab) Cells(sat, 1).Resize(, UBound(t) + 1).Value = t sat = sat + 1 Loop If tip = "4" Then Cells(ysat, UBound(t) + 2).Resize(sat - ysat, 1).Value = strFile.Name End If Columns.AutoFit Next strFile Set strFile = Nothing Set FSO = Nothing End Sub

Tam istediğim gibi çok teşekkür ederim.Emeklerinize Sağlık.