VBA ile txt dosyasından ayıklanmış veri almak

usta07 · 24 Eylül 2008

Aşağıda yazmaya çalıştığım kodlar da (kod denirse tabi çok hata var)
örnek dosyada ekledim zaman bulupta yardımcı olabilecek uzman arkadaşlarımıza Minnettar kalırım Selamlar iyi çalışmalar.

Private Sub CommandButton1_Click()
UserForm1.Hide
Worksheets("Veri").Select
Rows("3:9999").Select
Selection.ClearContents
Range("A4").Select
Open "C:\Test\List.txt" For Input As #1
i = 3
'For i = 1 To 3

Do While Not EOF(1)
Line Input #1, TextLine
' (1) Ayıklanmış liste elde etmek için aşağıdaki şartları yazdım.
If Mid(TextLine, 1, 6) = "BONUS " Or Mid(TextLine, 1, 6) = "KAPPAD" Or Mid(TextLine, 1, 6) = "GEWERK" Or Mid(TextLine, 1, 6) = "STFUAI" Or Mid(TextLine, 1, 6) = "WESHOF" Or Mid(TextLine, 1, 6) = "WESANA" Then
Kod = Mid(TextLine, 1, 6) 'Burası ok

'(2)Yukarıdaki şartlara uyan verilerin karşısına, (-1 Textline inde 55, 9) değerini yazdıramadım!!
If Mid(TextLine, 35, 1) = ":" And Mid(TextLine, 53, 1) Then
Arrival = Mid(TextLine, 55, 9)

'(1),(2)şartlara uyan ve aşğıdaki şartları taşıyan verilerinde (3),(4)sutuna yazdıramadım.
If Mid(TextLine, 79, 2) = "OK" Or Mid(TextLine, 79, 2) = "OP" Then
Cinsi = Mid(TextLine, 13, 3)
Madi = Mid(TextLine, 17, 20)

Cells(i, 1).Value = Kod 'Ürün kodları sonrakine kadar devam etmesi lazım
Cells(i, 2).Value = CStr(Arrival) 'Ürün geliş tarihi sonrakine kadar devam etmesi lazım
Cells(i, 3).Value = Cinsi ' Ürünü alan cinsiyeti
Cells(i, 4).Value = Madi 'Müşteri adı
i = i + 1
End If
End If
End If
Loop
Close #1

End Sub

Private Sub CommandButton2_Click()
UserForm1.Hide
End Sub

usta07 · 24 Eylül 2008

If Len(Trim(TextLine)) = 80 Then
Komutu ile yazdırabilirmiyiz?

Korhan Ayhan · 24 Eylül 2008

Selamlar,

Aşağıdaki kod bloğunda And komutundan sonraki kısım (kırmızı renkli bölüm) neye eşit olacak belirtmemişsiniz.

Kod:

If Mid(TextLine, 35, 1) = ":" And [COLOR=red]Mid(TextLine, 53, 1)[/COLOR] Then

usta07 · 25 Eylül 2008

Evet onu atlamışım Hocam... ama genel olarak döngüde bir mantık hatası yapıyorum ne olduğunu bir türlü bulamadım. her TextLine ayrı bilgi içeriyor.
1. şarta uyan veriyi excele aldıktan sonra 2. şarta uyan veriyi excelde aynı satıra 3. şarta uyan verileri de aynı satıra almasını istiyorum. şartların sıralamasını değiştirdim olmadı. acaba diyorum sadece belli bir aralığı almam gereken TextLine de "If Len(Trim(TextLine)) = 80 Then" sonra
Cells(i, 1).Value = Trim(Mid(TextLine, 55, 9)) sıralama nasıl olmalıki doğru sonuç versin ben bir çok kod denyorum örneğin son denemem de başarısız
Do While Not EOF(1)
Line Input #1, TextLine
If Mid(TextLine, 1, 6) = "BONUS " Or Mid(TextLine, 1, 6) = "KAPPAD" Or Mid(TextLine, 1, 6) = "GEWERK" Or Mid(TextLine, 1, 6) = "STFUAI" Or Mid(TextLine, 1, 6) = "WESHOF" Or Mid(TextLine, 1, 6) = "WESANA" Then Line Input #1, TextLine
Kod = Mid(TextLine, 1, 6) '/

If Mid(TextLine, 35, 1) = ":" And Mid(TextLine, 53, 1) = ":" Then Line Input #1, TextLine
Arrival = Mid(TextLine, 55, 9) '/

If Mid(TextLine, 79, 2) = "OK" Or Mid(TextLine, 79, 2) = "OP" Then
Cinsi = Mid(TextLine, 13, 3) '/
Madi = Mid(TextLine, 17, 20) '/

Cells(i, 1).Value = Kod
Cells(i, 2).Value = CStr(Arrival)
Cells(i, 3).Value = Cinsi
Cells(i, 4).Value = Madi
i = i + 1
End If
Loop
Close #1
Müsait olduğunuzda bir bakabilirseniz Bayrama kadar yurt dışı satışları görebileceğim Malum aynı şehirde aynı sektördeyiz ilglerinize teşekkür ediyorum.

veyselemre · 25 Eylül 2008

Kod:

    UserForm1.Hide
    Worksheets("Veri").Select
    Rows("3:9999").ClearContents
    Open "C:\Test\List.txt" For Input As #1
    i = 2
    Do While Not EOF(1)
        Line Input #1, textline
basla:
        If textline Like "Schne Touristik*" Then
            Line Input #1, textline
            sat = Trim(textline)
            Do While Not sat Like "DEST: AYT      ARRIVAL:*"
                Line Input #1, textline
                sat = Trim(textline)
            Loop
            arrivel = Trim(Replace(sat, "DEST: AYT      ARRIVAL:", ""))

            Line Input #1, textline
            kod = Left(textline, 6)

            If InStr("BONUS KAPPAD GEWERK STFUAI WESHOF WESANA", kod) Then
                Line Input #1, textline
                Do While Not textline Like "Schne Touristik*"
                    bak = Mid(textline, 79, 2)
                    If bak = "OK" Or bak = "OP" Then
                        cinsi = Mid(textline, 13, 3)
                        mAdi = Mid(textline, 17, 20)
                        Cells(i, 1) = Trim(kod)
                        Cells(i, 2) = Trim(arrivel)
                        Cells(i, 3) = Trim(cinsi)
                        Cells(i, 4) = Trim(mAdi)
                        i = i + 1
                    End If
                    Line Input #1, textline
                Loop
                GoTo basla
            End If
        End If
    Loop
    Close #1

usta07 · 25 Eylül 2008

Kardeş zaman ayırıp emek harcadığın için teşekkür ederim kodları olduğu kopyalıp yapıştırdım maalesef olmadı Compile eror:Invalid outside procedure mesajı verdi en alt satıra End sub yazdım kodu bitirmek için aynı mesajı verdi
biryerlerde bir eksiğimiz var da göremedim İlgi ve alakanıza teşekkür ederim.
ilgilenmeniz bile yeter. Elbette bizim göremediğimizi görecek bir uzman arkadaşımız çıkar. sağolun var olun...

veyselemre · 25 Eylül 2008

Ekteki örneğinizi inceleyin.

usta07 · 26 Eylül 2008

Kardeş olmuş..
Ellerine sağlık, Bu mübarek günün arefesinde çok makbule geçti Çok teşekkür ederim. benimde sizin için yapabileceğim bir şey olursa seve seve yaparım Allah razı olsun
Sevgi ve saygılarımla.
m USTA fa

volkia · 26 Eylül 2008

Arkadaşlar lütfen Yardım

elimde bir dosya ve A ve B isimli iki sheet'im var. Dosya ek'tedir.
A'nın ilk sütunu (site isimli olan sütun) B'nin ilk sütununa (site isimli sütun) ve tam tersi olan B'nin ilk sütununun A'nın ilk sütununa süzülmesi işlemlerini gerçekleştirmek istiyorum. Yardımcı olursanız sevinirim.

Excel 2000 kullanıyorum bu arada türkçe

usta07 · 27 Eylül 2008

Hata mesajı da vermiyor veride almıyor...

Aşağıda Veysel Emre kardeşimizin yazdığı kodlara ilave yapmak istedim ama çalıştıramadım hata da vermiyor veride almıyor neden olabirir? çalışmayan kodu kırmızı ile işaretledim.
ilgi ve alakalarınıza teşekkür ederim.

Private Sub CommandButton1_Click()
UserForm1.Hide
Worksheets("Veri").Select
[A3:J65000].ClearContents
Open "C:\Test\Lists.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))

'If textline Like "Schne Touristik*" Then
'Line Input #1, textline
'Do While Not textline Like "ROOM:*"
'Line Input #1, textline
'Loop
'room = Trim(Mid(textline, 7, 2))
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
End If
Line Input #1, textline
Loop
GoTo basla
End If
'End If End If
Loop
Close #1

End Sub

Private Sub CommandButton2_Click()
UserForm1.Hide
End Sub

VBA ile txt dosyasından ayıklanmış veri almak

usta07

Destek Ekibi

usta07

Destek Ekibi

Korhan Ayhan

Administrator

usta07

Destek Ekibi

veyselemre

Özel Üye

usta07

Destek Ekibi

veyselemre

Özel Üye

usta07

Destek Ekibi

volkia

usta07

Destek Ekibi