Txt dosyasındaki gereksiz satırları silmek

[Korhan Ayhan]

Selamlar,

Aşağıda Sn. Haluk beye ait kodlara belirli kriterler eklemek istiyorum.

Kriterlerim;
1- Boş olan satırlar silinecek.

2- 21-05-2006 tarihinden küçük ve 20-06-2006 tarihinden büyük tarih içeren satırlar silinecek.

3- İçerisinde "running" geçen satırlar silinecek.

Sonuç olarak aslında 2. kriterime uymayan bütün gereksiz satırları silmek istiyorum.

Sub GereksizSatırlarıSil()
    Dim MyFile As String, MyTempFile As String
    Dim FileNum1 As Long, FileNum2 As Long
    MyFile = "C:\DATA.txt"
    MyTempFile = "C:\Temp.txt"
    FileNum1 = FreeFile
    Open MyFile For Input As #FileNum1
    FileNum2 = FreeFile
    Open MyTempFile For Output As #FileNum2
    While Not EOF(FileNum1)
    Line Input #FileNum1, TextData
    If TextData = "" Then GoTo ResumeLoop:
    Print #FileNum2, TextData
ResumeLoop:
    Wend
    Close #FileNum2
    Close #FileNum1
    Kill MyFile
    Name MyTempFile As MyFile
MsgBox "İşlem başarıyla tamamlanmıştır.", vbInformation
End Sub

 

[veyselemre]

Merhaba,
Örnek text dosyası eklerseniz daha kolay olur.

 

[Korhan Ayhan]

Selamlar,

Küçültülmüş örnek dosya ektedir.

 

[Haluk]

zip olarak eklermisiniz ?

 

[Korhan Ayhan]

Selamlar,

Haluk bey ekledim. :hey:

 

[veyselemre]

[vb:1:6e16995ef0]Sub GereksizSatırlarıSil()
Dim MyFile As String, MyTempFile As String
Dim FileNum1 As Long, FileNum2 As Long
Dim tar1 As Date, tar2 As Date
tar1 = "21.05.2006"
tar2 = "20.06.2006"
MyFile = "C:\DATA.txt"
MyTempFile = "C:\Temp.txt"
FileNum1 = FreeFile
Open MyFile For Input As #FileNum1
FileNum2 = FreeFile
Open MyTempFile For Output As #FileNum2
While Not EOF(FileNum1)
Line Input #FileNum1, TextData
If TextData = "" Or InStr(TextData, "running.") > 0 Then GoTo ResumeLoop:
tar = Mid(TextData, 1, 10)
If IsDate(tar) And tar >= tar1 And tar <= tar2 Then Print #FileNum2, TextData
ResumeLoop:
Wend
Close #FileNum2
Close #FileNum1
Kill MyFile
Name MyTempFile As MyFile
MsgBox "İşlem başarıyla tamamlanmıştır.", vbInformation
End Sub[/vb:1:6e16995ef0]

 

[Haluk]

Tam olarak kontrol etmedim ama siz bir deneyin ...

Sub Test()
    Dim MyFile As String, MyTempFile As String
    Dim FileNum1 As Long, FileNum2 As Long
    MyFile = "C:\DATA.txt"
    MyTempFile = "C:\Temp.txt"
    FileNum1 = FreeFile
    Open MyFile For Input As #FileNum1
    FileNum2 = FreeFile
    Open MyTempFile For Output As #FileNum2
    While Not EOF(FileNum1)
    Line Input #FileNum1, TextData
    RetVal = Split(TextData, " ")
    For i = 0 To UBound(RetVal)
    If IsDate(RetVal(i)) Then
    If (RetVal(i) > DateValue("20.06.2006") Or RetVal(i) < DateValue("21.05.2006")) Then TextData = Empty
    End If
    Next
    If TextData = "" Then
    GoTo ResumeLoop:
    End If
    Print #FileNum2, TextData
ResumeLoop:
    Wend
    Close #FileNum2
    Close #FileNum1
    Kill MyFile
    Name MyTempFile As MyFile
MsgBox "İşlem başarıyla tamamlanmıştır.", vbInformation
End Sub

 

[Korhan Ayhan]

Selamlar,

Sn. Haluk bey kodlarınızı denedim fakat gerekli olanlar silinip gereksiz satırlar kalıyor.

Sn. veyselemre beyin kodu işimi gördü kontrol edip eğer bir hata varsa tekrar rahatsız ederim. :hey: