Txt'den txt dosyasına yazdırma kodu için yardım

[castoridae]

Tüm forumdaşlara öncelikli olarak merhabalar.
İçerisinde fazlaca veri bulunan bir txt dosyasından istediğim kısımları kopyalamak, ve kopyaladığım kısmı başka bir txt dosyasına yazdıracak bir vba kodu hazırlamaya çalışıyorum ancak bir türlü başarılı olamadım.
Örnek olarak açıklamam gerekirse bir şehirdeki otobüs hatlarının, hangi duraktan hangi saatlerde otobüs geçtiğini belirten bir liste olsun. Mesala ben 3 numaralı duraktan saat 22:00 ile 22:45 arasında geçen otobüsleri, o txt dosyasından tek tıklama ile başka bir txt dosyasına kopyalayıp orada görmek istiyorum.
Daha önce benzer basit bir aramayı yaptırıp excelle yazdırdım ama bu iş beni oldukça aştı, yardımcı olursanız çok sevinirim.

    Sub Arama()
    
    Dim myFile As String
    text As String
    textline As String
    posLat As Integer
    posLong As Integer
    
    
   myFile = "C:\Documents and Settings\...\1.txt"
    Open myFile For Input As #1
    Do Until EOF(1)
        Line Input #1, textline
        text = text & textline
    Loop
    Close #1
posLat = InStr(text, "latitude")
posLong = InStr(text, "longitude")
Range("A1").Value = Mid(text, Enlem + 6, 5)
Range("A2").Value = Mid(text, Boylam + 7, 5)

End Sub

Yardımcı olan ve olmaya çalışan herkese şimdiden teşekkürler.

 

[halit3]

örnek dosya ekleyiniz.

ayrıca örnek dosyadan çıkartacağınız sonuç ile de ilgili olmasını istediğiniz dosyayı da ekleyiniz.

 

[castoridae]

Sayın @halit3

*Dosya eklemeyi beceremedim ama txt dosyasının içeriği şu şekilde;
1 Nolu Durak
1;O1;06:20:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
2;O1;06:32:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
3;O1;06:44:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
4;O1;06:56:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
...
2 Nolu Durak
1;O1;06:20:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
2;O1;06:32:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
3;O1;06:44:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
4;O1;06:56:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
...
3 Nolu Durak
1;O1;06:20:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
2;O1;06:32:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
3;O1;06:44:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
4;O1;06:56:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
...
4 Nolu Durak
1;O1;06:20:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
2;O1;06:32:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
3;O1;06:44:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
4;O1;06:56:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0

Bir yere kadar kodu aşağıdaki şekilde düzenledim. txt dosyası içinde istediğim değeri aratabiliyor ve çıkan sonuçları başka bir txt dosyasına yazdırabiliyorum. Ancak dosya içindeki her sonucu bulup getiriyor hali ile. Örneğin Saat 06:20 diyince 4 durağında ilk seferlerini toplayıp geliyor. Şu anda tek ihtiyacım olan ilgili başlıklar arasında arama yapabilmek. "3 Nolu durak" ile "4 Nolu Durak" başlıkları arasında aramayı sınırlandırmak istiyorum, böylece sadece 3 nolu durağı inceleyebileceğim mesala. Bu koda ne eklemeliyimki iki başlık arası arama yapsın? Hazırladığım kod aşağıdaki gibi.
Saygılar.

    Sub Arama()
    
    Dim Veriler As String, Ciktilar As String,
    
    
    Veriler = "C:\Documents and Settings\...\1.txt"
    Ciktilar = "C:\Documents and Settings\...\2.txt"
    Open Veriler For Input As #1
    Open Ciktilar For Output As #2
    
     aranan = "06:20"
    
    Do Until EOF(1)
      Line Input #1, veri
        If InStr(1, veri, aranan) Then
            say = say + 1
            Print #2, veri
        End If
    Loop
    Close

    End Sub

 

[halit3]

bu kodu bir dene
not= dosya adreslerini kendiniz belirleyin.

Sub verial()

ad1 = [COLOR="Red"]"C:\Documents and Settings\User\Desktop\dosya\1.txt"[/COLOR]
ad2 = [COLOR="red"]"C:\Documents and Settings\User\Desktop\dosya\2.txt"[/COLOR]
say = 0

aranan = [COLOR="Blue"]"3 Nolu Durak"[/COLOR]

On Error Resume Next
Open ad1 For Input As #1
Open ad2 For Output As #2
 
Do While Not EOF(1)
Line Input #1, deg

If Trim(deg) = aranan Then
say = 1
End If

If say = 1 Then
If Trim(deg) = [COLOR="blue"]"..."[/COLOR] Then GoTo atla
Print #2, deg

End If

Loop
atla:
Close #1

Close #2

MsgBox "işlem tamam"

End Sub

 

[castoridae]

bu kodu bir dene
not= dosya adreslerini kendiniz belirleyin.

Sub verial()

ad1 = [COLOR="Red"]"C:\Documents and Settings\User\Desktop\dosya\1.txt"[/COLOR]
ad2 = [COLOR="red"]"C:\Documents and Settings\User\Desktop\dosya\2.txt"[/COLOR]
say = 0

aranan = [COLOR="Blue"]"3 Nolu Durak"[/COLOR]

On Error Resume Next
Open ad1 For Input As #1
Open ad2 For Output As #2
 
Do While Not EOF(1)
Line Input #1, deg

If Trim(deg) = aranan Then
say = 1
End If

If say = 1 Then
If Trim(deg) = [COLOR="blue"]"..."[/COLOR] Then GoTo atla
Print #2, deg

End If

Loop
atla:
Close #1

Close #2

MsgBox "işlem tamam"

End Sub

Sayın halit3;
Veridğiniz kod istediğim başlık aralarını ayırıyor ancak o başlığı olduğu gibi kopyalayıp getiriyor. Ben sadece istediğim kısımları almasını istiyorum. Mesala 06:20 tercihi yapıp sadece o satırı getirmesini istiyorum.
Saygılara.

 

[halit3]

Sayın halit3;
Veridğiniz kod istediğim başlık aralarını ayırıyor ancak o başlığı olduğu gibi kopyalayıp getiriyor. Ben sadece istediğim kısımları almasını istiyorum. Mesala 06:20 tercihi yapıp sadece o satırı getirmesini istiyorum.
Saygılara.

Ben önceki mesajımda örnek dosya eklemeniz bunun için istemiştim.

1 Nolu Durak
1;O1;06:20:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
2;O1;06:32:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
3;O1;06:44:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
4;O1;06:56:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
...
2 Nolu Durak
1;O1;06:20:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
2;O1;06:32:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
3;O1;06:44:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
4;O1;06:56:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
...
3 Nolu Durak
1;O1;06:20:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
2;O1;06:32:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
3;O1;06:44:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
4;O1;06:56:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
...
4 Nolu Durak
1;O1;06:20:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
2;O1;06:32:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
3;O1;06:44:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
4;O1;06:56:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0

yuakrıdaki dosya içeriğinden nasıl bir dosya elde etmek istiyorsunuz.
benim örneğimde arma kriteri (3 Nolu Durak) bu

sonuç olarak aşağıdaki gibi bir dosya çıkıyor.
siz sonucun ne olmasını istiyorsunuz.

3 Nolu Durak
1;O1;06:20:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
2;O1;06:32:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
3;O1;06:44:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
4;O1;06:56:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0

 

[castoridae]

Benim bu işlem sonucunda yanlızca 3 nolu durağı incelemek istediğim doğru ancak 3 nolu duraktan geçen tüm otobüsleri değil, sadece istediğim saatlerdeki otobüsleri görsün istiyorum. Atıyorum 6:20 ila 6:50 arasında geçen otobüsleri listelesin. Yani;

1;O1;06:20:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
2;O1;06:32:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
3;O1;06:44:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
Sonucu oluşşun. yani 4. otobüsü listeye dahil etmesin.
Saygılar.

Ben önceki mesajımda örnek dosya eklemeniz bunun için istemiştim.

1 Nolu Durak
1;O1;06:20:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
2;O1;06:32:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
3;O1;06:44:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
4;O1;06:56:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
...
2 Nolu Durak
1;O1;06:20:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
2;O1;06:32:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
3;O1;06:44:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
4;O1;06:56:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
...
3 Nolu Durak
1;O1;06:20:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
2;O1;06:32:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
3;O1;06:44:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
4;O1;06:56:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
...
4 Nolu Durak
1;O1;06:20:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
2;O1;06:32:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
3;O1;06:44:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
4;O1;06:56:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0

yuakrıdaki dosya içeriğinden nasıl bir dosya elde etmek istiyorsunuz.
benim örneğimde arma kriteri (3 Nolu Durak) bu

sonuç olarak aşağıdaki gibi bir dosya çıkıyor.
siz sonucun ne olmasını istiyorsunuz.

3 Nolu Durak
1;O1;06:20:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
2;O1;06:32:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
3;O1;06:44:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0
4;O1;06:56:00;Otobus_01;O01;>;1;1;57;1;0;0;0;0

 

[halit3]

Bide bu kodu denermisiniz.

Sub verial()
say = 0
ad1 = [COLOR="red"]"C:\Documents and Settings\User\Desktop\dosya\1.txt"[/COLOR]
ad2 = [COLOR="Red"]"C:\Documents and Settings\User\Desktop\dosya\2.txt"[/COLOR]

aranan_durak = [COLOR="Blue"]"3 Nolu Durak"[/COLOR]
aranan_saat1 = [COLOR="blue"]"06:20:00"[/COLOR]
aranan_saat2 = [COLOR="blue"]"06:50:00"[/COLOR]

On Error Resume Next
Open ad1 For Input As #1
Open ad2 For Output As #2
 
Do While Not EOF(1)
Line Input #1, deg1

If Trim(deg1) = aranan_durak Then
say = 1
End If

If say = 1 Then
If Trim(deg1) = "..." Then GoTo atla
deg2 = Split(Trim(deg1), ";")
If UBound(deg2) > 0 Then
'MsgBox CDate(deg2(2)) & Chr(10) & CDate(aranan_saat1)
If CDate(aranan_saat1) <= CDate(deg2(2)) And CDate(aranan_saat2) >= CDate(deg2(2)) Then
'MsgBox deg2(2)
Print #2, deg1
End If
End If

End If

Loop
atla:
Close #1

Close #2

MsgBox "işlem tamam"

End Sub

 

[castoridae]

Üstad ellerine sağlık gayet iyi çalıştı. Çok büyük bir yükten kurtardınız beni.
Trim, UBound ve CDate komutlarının ne işe yaradığı hakkında bilgi verirseniz ziyadesi ile memnun olurum.

Bide bu kodu denermisiniz.

Sub verial()
say = 0
ad1 = [COLOR="red"]"C:\Documents and Settings\User\Desktop\dosya\1.txt"[/COLOR]
ad2 = [COLOR="Red"]"C:\Documents and Settings\User\Desktop\dosya\2.txt"[/COLOR]

aranan_durak = [COLOR="Blue"]"3 Nolu Durak"[/COLOR]
aranan_saat1 = [COLOR="blue"]"06:20:00"[/COLOR]
aranan_saat2 = [COLOR="blue"]"06:50:00"[/COLOR]

On Error Resume Next
Open ad1 For Input As #1
Open ad2 For Output As #2
 
Do While Not EOF(1)
Line Input #1, deg1

If Trim(deg1) = aranan_durak Then
say = 1
End If

If say = 1 Then
If Trim(deg1) = "..." Then GoTo atla
deg2 = Split(Trim(deg1), ";")
If UBound(deg2) > 0 Then
'MsgBox CDate(deg2(2)) & Chr(10) & CDate(aranan_saat1)
If CDate(aranan_saat1) <= CDate(deg2(2)) And CDate(aranan_saat2) >= CDate(deg2(2)) Then
'MsgBox deg2(2)
Print #2, deg1
End If
End If

End If

Loop
atla:
Close #1

Close #2

MsgBox "işlem tamam"

End Sub

 

[halit3]

Trim=Bir dizideki birden fazla boşlukları kaldırmak.
UBound =Dizilerin ilk ve son eleman numaralarını tespit etmek (yani biz bu kodda ; noktalı virgülü aratıyoruz eğer dizide noktalı virgül varsa kaç adet olduğunu öğrenmek için
CDate=bir saat formatında görünen dizinin saat olarak algılanması için (örnek "06:20:00" bu değer saat gibi görünsede saat formatına çevirmek gerekiyor.)

 

[castoridae]

Trim=Bir dizideki birden fazla boşlukları kaldırmak.
UBound =Dizilerin ilk ve son eleman numaralarını tespit etmek (yani biz bu kodda ; noktalı virgülü aratıyoruz eğer dizide noktalı virgül varsa kaç adet olduğunu öğrenmek için
CDate=bir saat formatında görünen dizinin saat olarak algılanması için (örnek "06:20:00" bu değer saat gibi görünsede saat formatına çevirmek gerekiyor.)

Çok teşekkür ediyorum tekrardan. Çok yararlı oldu benim adıma, ellerinize sağlık.