- Katılım
- 26 Mayıs 2016
- Mesajlar
- 19
- Excel Vers. ve Dili
- excel 2007
- Altın Üyelik Bitiş Tarihi
- 05-06-2023
Aşağıda belirttiğim kod ile başka bir dosyadan .txt uzantılı verılerı excel sayfama cekiyorum.Fakat bugün boyle birhata verdi işlemi tam gerçekleştirmedi "Cells(ysat, UBound(t) + 2).Resize(sat - ysat, 1).Value = strFile.Name" koddaki bu kısım sarı olarak isaretlendi. Sebebi nedir acaba? nerede yanlışlık yapıyorum.
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
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