[ÇÖZÜLDÜ] Do While .. Loop

U

usta07

Destek Ekibi
Destek Ekibi
Katılım
30 Mart 2008
Mesajlar
405
Excel Vers. ve Dili
2003 Türkçe
Do While …. Loop döngüsü arasında 2 ayrı koşul çalıştırılabilirmi? Nasıl?
Bir türlü çalıştıramadım Uzman arkadaşlarımızın yardımları Allah indinde zayi olmayacaktır. Teşekkürler.. sorunlu alanı buraya yazdım ekte örnek dosya var. mevcut çalışma Veysel emre kardeşimizin yardımları ile bu hale geldi


Do While Not TextLine Like "Schne Touristik*"
bak = Trim(Mid(TextLine, 78, 3))
If bak = "OK" Or bak = "OP" Then
vgnr = Mid(TextLine, 4, 8)
cins = Mid(TextLine, 13, 3)
madi = Mid(TextLine, 17, 20)
gunu = Mid(TextLine, 40, 2)
pans = Mid(TextLine, 43, 2)
ucak = Mid(TextLine, 46, 7)
saat = Mid(TextLine, 54, 4)
Cells(i, 1) = Trim(kod)
Cells(i, 2) = Trim(arrival)
Cells(i, 3) = Trim(0)
Cells(i, 4) = Trim(vgnr)
Cells(i, 5) = Trim(cins)
Cells(i, 6) = Trim(madi)
Cells(i, 7) = Trim(gunu)
Cells(i, 8) = Trim(pans)
Cells(i, 9) = Trim(ucak)
Cells(i, 10) = Trim(saat)
i = i + 1
If Mid(TextLine, 5, 1) = ":" And Mid(TextLine, 10, 1) = "=" Then
Cells(i, 3).Value = Trim(Mid(TextLine, 7, 2))
i = i + 1 End If
End If
Line Input #1, TextLine
Loop
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,536
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

ROOM olarak belirttiğiniz alana txt dosyasındaki hangi bilgi yazdırılacak belirtirmisiniz.
 
U

usta07

Destek Ekibi
Destek Ekibi
Katılım
30 Mart 2008
Mesajlar
405
Excel Vers. ve Dili
2003 Türkçe
Text dosyasında 1, 5 = "ROOM:" olan satırdan hemen sonra gelen 7, 2 karekterleri excelde 3. sutuna

Cells(i, 3).Value = Trim(Mid(TextLine, 7, 2))
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,536
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

Aşağıdaki kodu denermisiniz.

Kod: 
Private Sub CommandButton1_Click()
    UserForm1.Hide
    Worksheets("Veri").Select
    [A3:j65000].ClearContents
    Open "C:\Test\List.txt" For Input As #1
    i = 3
    Do While Not EOF(1)
        Line Input #1, TextLine
basla:
        If TextLine Like "Schne Touristik*" Then
            Line Input #1, TextLine
            Do While Not TextLine Like "*DEST: AYT*     ARRIVAL:*"
                Line Input #1, TextLine
            Loop
            arrival = Trim(Mid(TextLine, 55, 10))
            Line Input #1, TextLine
            kod = Left(TextLine, 6)
            If InStr("BONUS BONUS4 KAPPAD GEWERK STFUAI STVIAI SUDWES WESHOF PAUHOF WESANA", kod) Then
                Line Input #1, TextLine
                Do While Not TextLine Like "Schne Touristik*"
                    bak = Trim(Mid(TextLine, 78, 3))
                        If bak = "ok" Or bak = "OK" Then
                            vgnr = Mid(TextLine, 4, 8)
                            cins = Mid(TextLine, 13, 3)
                            madi = Mid(TextLine, 17, 20)
                            gunu = Mid(TextLine, 40, 2)
                            pans = Mid(TextLine, 43, 2)
                            ucak = Mid(TextLine, 46, 7)
                            saat = Mid(TextLine, 54, 4)
                            Cells(i, 1) = Trim(kod)
                            Cells(i, 2) = Trim(arrival)
                            Cells(i, 3) = Trim(room)
                            Cells(i, 4) = Trim(vgnr)
                            Cells(i, 5) = Trim(cins)
                            Cells(i, 6) = Trim(madi)
                            Cells(i, 7) = Trim(gunu)
                            Cells(i, 8) = Trim(pans)
                            Cells(i, 9) = Trim(ucak)
                            Cells(i, 10) = Trim(saat)
                            i = i + 1
                        ElseIf Mid(TextLine, 5, 1) = ":" And Mid(TextLine, 10, 1) = "=" Then
                            Cells(i, 3).Value = Trim(Mid(TextLine, 7, 2))
                            room = Trim(Mid(TextLine, 7, 2))
                        End If
                Line Input #1, TextLine
                Loop
                GoTo basla
            End If
        End If
    Loop
    Close #1
End Sub
 
U

usta07

Destek Ekibi
Destek Ekibi
Katılım
30 Mart 2008
Mesajlar
405
Excel Vers. ve Dili
2003 Türkçe
Hocam çok teşekkür ederim. elinize sağlık.
şimdi Sayın Uzman Korhan Ayhan tarafından çözümlendi diye işaretlemem lazım.
Tabiki Veysel Emre kardeşimizin de yazmadan olmaz..
İyi bayramlar.
 
U

usta07

Destek Ekibi
Destek Ekibi
Katılım
30 Mart 2008
Mesajlar
405
Excel Vers. ve Dili
2003 Türkçe
Korhan Ayhan' Alıntı:
Selamlar,

Aşağıdaki kodu denermisiniz.

Kod: 
Private Sub CommandButton1_Click()
    UserForm1.Hide
    Worksheets("Veri").Select
    [A3:j65000].ClearContents
    Open "C:\Test\List.txt" For Input As #1
    i = 3
    Do While Not EOF(1)
        Line Input #1, TextLine
basla:
        If TextLine Like "Schne Touristik*" Then
            Line Input #1, TextLine
            Do While Not TextLine Like "*DEST: AYT*     ARRIVAL:*"
                Line Input #1, TextLine
            Loop
            arrival = Trim(Mid(TextLine, 55, 10))
            Line Input #1, TextLine
            kod = Left(TextLine, 6)
            [COLOR="red"]If InStr("BONUS BONUS4 KAPPAD GEWERK STFUAI STVIAI SUDWES WESHOF PAUHOF WESANA", kod) Then[/COLOR]                Line Input #1, TextLine
                Do While Not TextLine Like "Schne Touristik*"
                    bak = Trim(Mid(TextLine, 78, 3))
                        If bak = "ok" Or bak = "OK" Then
                            vgnr = Mid(TextLine, 4, 8)
                            cins = Mid(TextLine, 13, 3)
                            madi = Mid(TextLine, 17, 20)
                            gunu = Mid(TextLine, 40, 2)
                            pans = Mid(TextLine, 43, 2)
                            ucak = Mid(TextLine, 46, 7)
                            saat = Mid(TextLine, 54, 4)
                            Cells(i, 1) = Trim(kod)
                            Cells(i, 2) = Trim(arrival)
                            Cells(i, 3) = Trim(room)
                            Cells(i, 4) = Trim(vgnr)
                            Cells(i, 5) = Trim(cins)
                            Cells(i, 6) = Trim(madi)
                            Cells(i, 7) = Trim(gunu)
                            Cells(i, 8) = Trim(pans)
                            Cells(i, 9) = Trim(ucak)
                            Cells(i, 10) = Trim(saat)
                            i = i + 1
                        ElseIf Mid(TextLine, 5, 1) = ":" And Mid(TextLine, 10, 1) = "=" Then
                            Cells(i, 3).Value = Trim(Mid(TextLine, 7, 2))
                            room = Trim(Mid(TextLine, 7, 2))
                        End If
                [COLOR="Red"]Line Input #1, TextLine[/COLOR]
                Loop
                GoTo basla
            End If
        End If
    Loop
    Close #1
End Sub
Genişletmek için tıkla ...
Kırmızı renk ile belirtilen If InStr("BONUS sorgusu ile başlayan satıra ilave yapılınca sorgu toplamı 206 karakter ediyor ve Line Input #1, TextLine hatası veriyor alması gereken tüm bilgileri alamıyor neden olabilir bu uzman arkadaşlarımızın yardımına ihtiyacım var
 
U

usta07

Destek Ekibi
Destek Ekibi
Katılım
30 Mart 2008
Mesajlar
405
Excel Vers. ve Dili
2003 Türkçe
If InStr (.....'Başlayan
End If ' (ie biten sorguyu kaldırdım fakat
Line Input #1, TextLine hatası devam ediyor

On Error Resume Next (kabul etmiyor.
Bu hatayı nasıl yok edebilirim.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,536
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

Hata veren dosyanızı eklerseniz yardımcı olabiliriz.
 
U

usta07

Destek Ekibi
Destek Ekibi
Katılım
30 Mart 2008
Mesajlar
405
Excel Vers. ve Dili
2003 Türkçe
Korhan Bey,
.txt .xls dosyalarını ekledim.
ilgilerinize teşekkürler.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,536
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

Kullandığınız kodu aşağıdaki şekilde değiştirip denermisiniz.

Kod: 
Private Sub CommandButton1_Click()
    UserForm1.Hide
    Worksheets("Veri").Select
    [A3:j65000].ClearContents
    Open "C:\Test\List.txt" For Input As #1
    i = 3
    Do While Not EOF(1)
        Line Input #1, TextLine
basla:
        If TextLine Like "Schne Touristik*" Then
            Line Input #1, TextLine
            Do While Not TextLine Like "*DEST: AYT*     ARRIVAL:*"
                Line Input #1, TextLine
            Loop
            arrival = Trim(Mid(TextLine, 55, 10))
            Line Input #1, TextLine
            kod = Left(TextLine, 6)
            If InStr("ADAEVA ANATOL BONUS BONUS4 DAIRES DELPLC GEWERK HOFGLO JOYNAS KAPPAD LIMLIM PAUHOF SILENC SILHOF SORGUN STFUAI STVIAI SUDWES VENPAL WESANA WESHOF WRSTAE", kod) Then
                Line Input #1, TextLine
                Do While Not TextLine Like "Schne Touristik*"
                    bak = Trim(Mid(TextLine, 78, 3))
                        If bak = "ok" Or bak = "OK" Then
                            vgnr = Mid(TextLine, 4, 8)
                            cins = Mid(TextLine, 13, 3)
                            madi = Mid(TextLine, 17, 20)
                            gunu = Mid(TextLine, 40, 2)
                            pans = Mid(TextLine, 43, 2)
                            ucak = Mid(TextLine, 46, 7)
                            saat = Mid(TextLine, 54, 4)
                            Cells(i, 1) = Trim(kod)
                            Cells(i, 2) = Trim(arrival)
                            Cells(i, 3) = Trim(vgnr)
                            Cells(i, 4) = Trim(room)
                            Cells(i, 5) = Trim(cins)
                            Cells(i, 6) = Trim(madi)
                            Cells(i, 7) = Trim(gunu)
                            Cells(i, 8) = Trim(pans)
                            Cells(i, 9) = Trim(ucak)
                            Cells(i, 10) = Trim(saat)
                            i = i + 1
                        ElseIf Mid(TextLine, 5, 1) = ":" And Mid(TextLine, 10, 1) = "=" Then
                            Cells(i, 4).Value = Trim(Mid(TextLine, 7, 2))
                            room = Trim(Mid(TextLine, 7, 2))
                        End If
                [COLOR=red]On Error GoTo Son[/COLOR]
                Line Input #1, TextLine
                Loop
                GoTo basla
            End If
        End If
    Loop
[COLOR=red]Son:
[/COLOR]    Close #1
End Sub

Private Sub CommandButton2_Click()
UserForm1.Hide
End Sub
 
U

usta07

Destek Ekibi
Destek Ekibi
Katılım
30 Mart 2008
Mesajlar
405
Excel Vers. ve Dili
2003 Türkçe
Korhan Bey,
Teşekkürler
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst