• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

txt dosyasından kritere göre veri çekmek

numan şamil

Destek Ekibi
Destek Ekibi
Katılım
27 Ocak 2011
Mesajlar
1,238
Excel Vers. ve Dili
Ofis 2013 Türkçe
Merhaba arkadaşlar
bir klosörde 40 -50 adet txt dosyam var.Bunlardan excele veri çekiyorum Ancak txt dosyalarının veri çekilen satır sayısı standart değil bu yüzden standart satır sayısına göre verileri çekemiyorum
Acaba txt dosyalarında bir kritere göre tarayıp veri çekebilirmiyim? Kodlarımda buna göre nasıl düzenleme yapabilirim?
Örn:txt dosyalarımda
satırlarda
1) 6-7-8-9-10-11-12-13-14 ve15. karakterler [STX]0.0.0 eşit ise aynı satırdaki 09040924 veriyi alsın örnek dosyamdaki excelde (x firmasında aktarıldığı gibi) 3 nolu sutuna aktarsın
2) 6-7-8-9-10-11-12-13-14 ve15. karakterler [STX]1.6.0*1 eşit ise aynı satırdaki 000.364 veriyi alsın excelde 13 nolu sutuna aktarsın
3) 6-7-8-9-10-11-12-13-14 ve15. karakterler [STX]1.8.1*1 eşit ise aynı satırdaki 00005.389 veriyi alsın excelde 4 nolu sutuna aktarsın
4) 6-7-8-9-10-11-12-13-14 ve15. karakterler [STX]1.8.1*2 eşit ise aynı satırdaki 00004.456 veriyi alsın excelde 14 nolu sutuna aktarsın
5) 6-7-8-9-10-11-12-13-14 ve15. karakterler [STX]1.8.2*1 eşit ise aynı satırdaki 00190.420 veriyi alsın excelde 5 nolu sutuna aktarsın
6) 6-7-8-9-10-11-12-13-14 ve15. karakterler [STX]1.8.2*2 eşit ise aynı satırdaki 00171.035 veriyi alsın excelde 15 nolu sutuna aktarsın
7) 6-7-8-9-10-11-12-13-14 ve15. karakterler [STX]1.8.3*1 eşit ise aynı satırdaki 00339.725 veriyi alsın excelde 6 nolu sutuna aktarsın
8) 6-7-8-9-10-11-12-13-14 ve15. karakterler [STX]1.8.3*2 eşit ise aynı satırdaki 00273.626 veriyi alsın excelde 16 nolu sutuna aktarsın
9) 6-7-8-9-10-11-12-13-14 ve15. karakterler STX]5.8.1*1 eşit ise aynı satırdaki 00004.514 veriyi alsın excelde 7 nolu sutuna aktarsın
10) 6-7-8-9-10-11-12-13-14 ve15. karakterler [STX]5.8.1*2 eşit ise aynı satırdaki 00003.819 veriyi alsın excelde 17 nolu sutuna aktarsın
11) 6-7-8-9-10-11-12-13-14 ve15. karakterler [STX]5.8.2*1 eşit ise aynı satırdaki 00235.800 veriyi alsın excelde 8 nolu sutuna aktarsın
12) 6-7-8-9-10-11-12-13-14 ve15. karakterler [STX]5.8.2*2 eşit ise aynı satırdaki 00212.030 veriyi alsın excelde 18 nolu sutuna aktarsın
13) 6-7-8-9-10-11-12-13-14 ve15. karakterler [STX]5.8.3*1 eşit ise aynı satırdaki 00417.205 veriyi alsın excelde 9 nolu sutuna aktarsın
14) 6-7-8-9-10-11-12-13-14 ve15. karakterler [STX]5.8.3*2 eşit ise aynı satırdaki 00337.035 veriyi alsın excelde 19 nolu sutuna aktarsın
15) 6-7-8-9-10-11-12-13-14 ve15. karakterler [STX]8.8.1*1 eşit ise aynı satırdaki 00000.003 veriyi alsın excelde 10 nolu sutuna aktarsın
16) 6-7-8-9-10-11-12-13-14 ve15. karakterler [STX]8.8.1*2 eşit ise aynı satırdaki 00000.003 veriyi alsın excelde 20 nolu sutuna aktarsın
17) 6-7-8-9-10-11-12-13-14 ve15. karakterler STX]8.8.2*1 eşit ise aynı satırdaki 00000.000 veriyi alsın excelde 11 nolu sutuna aktarsın
18) 6-7-8-9-10-11-12-13-14 ve15. karakterler STX]8.8.2*2 eşit ise aynı satırdaki 00000.000 veriyi alsın excelde 21 nolu sutuna aktarsın
19) 6-7-8-9-10-11-12-13-14 ve15. karakterler [STX]8.8.3*1 eşit ise aynı satırdaki 00000.001 veriyi alsın excelde 12 nolu sutuna aktarsın
20) 6-7-8-9-10-11-12-13-14 ve15. karakterler [STX]8.8.3*2 eşit ise aynı satırdaki 00000.001 veriyi alsın excelde 22 nolu sutuna aktarsın
istiyorum
ekte örnek dosya gönderiyorum
not:(x-y adlı excel dosyası txt dosyalarının satırlarındaki kaymaları ve (sarı boyalı) alınması gereken verileri daha iyi göstermek içindir)
Uzman arkadaşlardan yardım bekliyorum iyi çalışmalar
 

Ekli dosyalar

İstediğim şey yapılabilinirmi Böyle birşey mümkünmüdür?
 
txt dosyalarını tarama yapıp krıtere uyan satırdaki bilgiler alınabilinirmi veya istediğim bu bilgileri alabileceğim başka yöntem varmı ?
bu konuda uzman arkadaşların yardımını bekliyorum
herkese iyi çalışmalar
 
Değerli Arkadaşlar zamanınız varsa ve bu konu hakkında olumlu veya olumsuz görüşlerinizi bekliyorum.
 
Merhaba,

Soru pek anlaşılır değil sanırım o yüzden kimse ilgilenmek istemiyor.

6-7-8-9-10-11-12-13-14 ve15. karekterler yani 6. karakterden başlayıp 10 karakter alınacak ve bu değer neye eşit olacak tam anlaşılmıyor.
 
Merhaba,

Soru pek anlaşılır değil sanırım o yüzden kimse ilgilenmek istemiyor.

6-7-8-9-10-11-12-13-14 ve15. karekterler yani 6. karakterden başlayıp 10 karakter alınacak ve bu değer neye eşit olacak tam anlaşılmıyor.

Merhabalar
Haklısınız sorum baya karışık
Evet 6. karekterden başlayıp 10 karekter alınacak ve bu değer [STX]1.8.1*1 karekterlerine eşit ise (aynısı ise) aynı satırdaki (10,8) yani 10.karekterden sonraki 8 adet sayısal değerleri almasını istiyorum bu 3. şık ile ilgili buna göre kodlar düzenlenirse bu kısmını gerektiği kadar çoğaltıp diger şıklar için düzenleye bilirim sanırım
ilginiz için çok teşekkür ederim.
 
Son düzenleme:
Arkadaşlar sorumda anlaşılmayan yerler varmı?
Bu konuda fikri olan varmı?
 
Merhaba,

Şarta uyan ama 10. karakterden itibaren 8 haneli bir sayısal değer ben göremedim.
Örneklerle anlatırsanıt yardımcı olacak arkadaşlar çıkabilir.
 
Merhaba,

Şarta uyan ama 10. karakterden itibaren 8 haneli bir sayısal değer ben göremedim.
Örneklerle anlatırsanıt yardımcı olacak arkadaşlar çıkabilir.

Merhaba necdet bey
Sanırım satırdaki karakter sayısında yanlışlık oldu arkadaşlar kusuruma bakmasınlar (1 nolu mesajda 15 olanlar 17 olacaktır) bu mesajda düzeltiyorum ve bir örnekle açıklamaya çalışacağım.
1 nolu mesajımdaki ekli dosyamda
örn: x firmasına ait txt dosyasında 128. satırdaki (not:Burda < ile [ arasındaki boşluk 4 karekter geçiyor deneme yolu ile buldum)
"< [STX]1.8.1*1(00005.389*kWh)[ETX]v"
00005.389 sayısal değerini
i = 4
ElseIf j = 128 Then
Cells(sat, i).Value = SAYIAL(Mid(a, 18, 10)) (Burda alınacak sayısal değerin 9 olduğu halde 10 yazılmasının nedeni bazen sayısal değer 10 olabiliyor)
kodlar ile çekip excel D sutnuna aktarabilyorum
Aktar adlı excel dosyasında D2 hücresine bakarsanız

Sorunum txt dosyalarındaki satır kayması örnekteki satır bazen 129 . satıra kaya biliyor bu yüzden txt dosyasında 6. karekterden başlayarak (6 dahil) den 17 (dahil) kadar satır taraması yapıp 6. karekterden başlayıp 17. karekter (dahil) karekterlerin
[STX]1.8.1*1 eşlenmesi durumunda aynı satırın 18. karekterden sonra 9 adet sayısal değer olan "00005.389" alıp excelde aktarılan sayfanın D sutununa aktarması (böyle 20 adet kriter aranacak)
Yani 6.7.8.9.10.11.12.13.14.15.16.17 karekterler=[STX]1.8.1*1 ise Cells(sat, i).Value = SAYIAL(Mid(a, 18, 9)) gibi
umarım anlaşılmıştır.
taranacak karakterler 6 dan değilde 1 den de başlaya bilir ozamanda aranacak kriter < [STX]1.8.1*1 şeklinde olacak tır < işaretinden sonra boşluk olması nedeniyle 6. karekterden başlamasını istedim
 
Son düzenleme:
Merhaba,

Şarta uyan ama 10. karakterden itibaren 8 haneli bir sayısal değer ben göremedim.
Örneklerle anlatırsanıt yardımcı olacak arkadaşlar çıkabilir.

Merhaba necdet bey
Sanırım satırdaki karakter sayısında yanlışlık oldu arkadaşlar kusuruma bakmasınlar
örn: x firmasına ait txt dosyasında 128. satırdaki (not:Burda < ile [ arasındaki boşluklar 4 karekter içeriyor deneme yolu ile buldum)
"< [STX]1.8.1*1(00005.389*kWh)[ETX]v"
00005.389 sayısal değerini
i = 4
ElseIf j = 128 Then
Cells(sat, i).Value = SAYIAL(Mid(a, 18, 10))
kodlar ile çekip excel D sutnuna aktara bilyorum
Aktar adlı excel dosyasında D2 hücresine bakarsanız

Sorunum txt dosyalarındaki satır kayması örnekteki satır bazen 129 . satıra kaya biliyor bu yüzden txt dosyasında 6. karekterden başlayarak (6 dahil) 17 (dahil) satır taraması yapıp 6. karekterde başlayıp 17. karekter dahil
[STX]1.8.1*1 eşlenmesi durumunda aynı satırın 18. karekterden sonra 9 adet sayısal değer olan 00005.389 alıp excelde aktarılan sayfanın D sutununa aktarması (böyle 20 adet kriter aranacak) not:9 adet sayısal değer bazen 8 olabiliyor orasını ben ayarlayabilirim
Yani 6.7.8.9.10.11.12.13.14.15.16.17 karekterler=[STX]1.8.1*1 ise Cells(sat, i).Value = SAYIAL(Mid(a, 18, 9))
gibi
umarım anlaşılmıştır.
istediğm olabilecek bir şeymi acaba?

Not:taranacak karakterler 6 dan değilde 1 den de başlaya bilir o zamanda aranacak kriter < [STX]1.8.1*1 şeklinde olacak tır < işaretinden sonra standart boşluklar olması nedeniyle karışıklığa meydan vermemesi için 6. karekterden başlamasını istedim
 
Son düzenleme:
Merhaba

Aşağıdaki kodları bir inceleyiniz bakalım, olmuş mu?

Kod:
Sub BrowseForFolder()
    Dim fdBrowser   As FileDialog, _
        DSat        As String, _
        i           As Long, _
        j           As Long, _
        k           As Integer, _
        Son         As Long
    Application.ScreenUpdating = False
 
    Son = Cells(Rows.Count, "D").End(3).Row
    If Son < 2 Then Son = 2
    Range("D2:E" & Son).ClearContents
 
    Set fdBrowser = Application.FileDialog(msoFileDialogOpen)
 
    With fdBrowser
 
        'İlk kullanıma aç
        .Title = "Metin (Text) Dosyasını Seçiniz"
        .InitialFileName = "C:\"
 
        'İletişim Kutusunu Göster
        If .Show Then
 
            Open .SelectedItems(1) For Input As #1
            i = 1
            j = 0
            While Not EOF(1)
 
                Line Input #1, DSat
                j = j + 1
                If Mid(DSat, 5, 12) = "[STX]1.8.1*1" Then
                    k = InStr(1, DSat, "(", vbTextCompare)
                    i = i + 1
                    Range("D" & i) = Mid(DSat, k + 1, 9)
                    Range("E" & i) = j
                End If
            Wend
 
        End If
 
    End With
    Application.ScreenUpdating = True
 
    MsgBox "İşlem tamlanmıştır....", vbInformation, "N. YEŞERTENER --> [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
 
End Sub
 

Ekli dosyalar

Merhaba

Aşağıdaki kodları bir inceleyiniz bakalım, olmuş mu?

Kod:
Sub BrowseForFolder()
    Dim fdBrowser   As FileDialog, _
        DSat        As String, _
        i           As Long, _
        j           As Long, _
        k           As Integer, _
        Son         As Long
    Application.ScreenUpdating = False
 
    Son = Cells(Rows.Count, "D").End(3).Row
    If Son < 2 Then Son = 2
    Range("D2:E" & Son).ClearContents
 
    Set fdBrowser = Application.FileDialog(msoFileDialogOpen)
 
    With fdBrowser
 
        'İlk kullanıma aç
        .Title = "Metin (Text) Dosyasını Seçiniz"
        .InitialFileName = "C:\"
 
        'İletişim Kutusunu Göster
        If .Show Then
 
            Open .SelectedItems(1) For Input As #1
            i = 1
            j = 0
            While Not EOF(1)
 
                Line Input #1, DSat
                j = j + 1
                If Mid(DSat, 5, 12) = "[STX]1.8.1*1" Then
                    k = InStr(1, DSat, "(", vbTextCompare)
                    i = i + 1
                    Range("D" & i) = Mid(DSat, k + 1, 9)
                    Range("E" & i) = j
                End If
            Wend
 
        End If
 
    End With
    Application.ScreenUpdating = True
 
    MsgBox "İşlem tamlanmıştır....", vbInformation, "N. YEŞERTENER --> [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
 
End Sub

Merhaba Necdet bey
Kodları elimden geldiği kadar inceledim bir önceki mesajda konunun anlaşılması için verdiğim tek veri çekimi için çalışıyor arada bir
Open .SelectedItems(1) For Input As #1 hata veriyor bunun sebebi nedir?
Ayrıca benim hatamdan kaynaklanan
"[STX]1.8.1*1" eşleştirmek için aradığı kriterden başka satırlarda
"[STX]1.8.1*11" ve benzeri varmış bu olayı "[STX]1.8.1*1(" eklentisi yaparak çözdüm
Esas ana sorunu çözüme ulaştırdınız
Galiba geri kalan kodların entegrasyonu
Mesaj 1 de belirttiğim gibi (20 şık)bir dosyadan çekilecek olan 20 adet verilerin baz alınacak kriterler ile çekilecek verileride kodlarınıza ekledim Başka nereleri değiştireceğimi veya ekleyeceğimi bilemiyorum
Dim fdBrowser As FileDialog, _
DSat As String, _
i As Long, _
j As Long, _
k As Integer, _
Son As Long
Application.ScreenUpdating = False

Son = Cells(Rows.Count, "D").End(3).Row
If Son < 2 Then Son = 2
Range("A2:W" & Son).ClearContents

Set fdBrowser = Application.FileDialog(msoFileDialogOpen)

With fdBrowser

'İlk kullanıma aç
.Title = "Metin (Text) Dosyasını Seçiniz"
.InitialFileName = "C:\"

'İletişim Kutusunu Göster
If .Show Then

Open .SelectedItems(1) For Input As #1
i = 1
j = 0
While Not EOF(1)

Line Input #1, DSat
j = j + 1
If Mid(DSat, 5, 11) = "[STX]0.0.0(" Then
k = InStr(1, DSat, "(", vbTextCompare)
i = i + 1
Range("C" & i) = Mid(DSat, k + 1, 8
If Mid(DSat, 5, 13) = "[STX]1.6.0*1(" Then
k = InStr(1, DSat, "(", vbTextCompare)
i = i + 1
Range("M" & i) = Mid(DSat, k + 1, 7)
If Mid(DSat, 5, 13) = "[STX]1.8.1*1(" Then
k = InStr(1, DSat, "(", vbTextCompare)
i = i + 1
Range("D" & i) = Mid(DSat, k + 1, 9)
If Mid(DSat, 5, 13) = "[STX]1.8.1*2(" Then
k = InStr(1, DSat, "(", vbTextCompare)
i = i + 1
Range("N" & i) = Mid(DSat, k + 1, 9)
If Mid(DSat, 5, 13) = "[STX]1.8.2*1(" Then
k = InStr(1, DSat, "(", vbTextCompare)
i = i + 1
Range("E" & i) = Mid(DSat, k + 1, 9)
If Mid(DSat, 5, 13) = "[STX]1.8.2*2(" Then
k = InStr(1, DSat, "(", vbTextCompare)
i = i + 1
Range("O" & i) = Mid(DSat, k + 1, 9)

If Mid(DSat, 5, 13) = "[STX]1.8.3*1(" Then
k = InStr(1, DSat, "(", vbTextCompare)
i = i + 1
Range("F" & i) = Mid(DSat, k + 1, 9)
If Mid(DSat, 5, 13) = "[STX]1.8.3*2(" Then
k = InStr(1, DSat, "(", vbTextCompare)
i = i + 1
Range("P" & i) = Mid(DSat, k + 1, 9)

If Mid(DSat, 5, 13) = "[STX]5.8.1*1(" Then
k = InStr(1, DSat, "(", vbTextCompare)
i = i + 1
Range("G" & i) = Mid(DSat, k + 1, 9)
If Mid(DSat, 5, 13) = "[STX]5.8.1*2(" Then
k = InStr(1, DSat, "(", vbTextCompare)
i = i + 1
Range("Q" & i) = Mid(DSat, k + 1, 9)

If Mid(DSat, 5, 13) = "[STX]5.8.2*1(" Then
k = InStr(1, DSat, "(", vbTextCompare)
i = i + 1
Range("H" & i) = Mid(DSat, k + 1, 9)
If Mid(DSat, 5, 13) = "[STX]5.8.2*2(" Then
k = InStr(1, DSat, "(", vbTextCompare)
i = i + 1
Range("R" & i) = Mid(DSat, k + 1, 9)

If Mid(DSat, 5, 13) = "[STX]5.8.3*1(" Then
k = InStr(1, DSat, "(", vbTextCompare)
i = i + 1
Range("I" & i) = Mid(DSat, k + 1, 9)
If Mid(DSat, 5, 13) = "[STX]5.8.3*2(" Then
k = InStr(1, DSat, "(", vbTextCompare)
i = i + 1
Range("S" & i) = Mid(DSat, k + 1, 9)
If Mid(DSat, 5, 13) = "[STX]8.8.1*1(" Then
k = InStr(1, DSat, "(", vbTextCompare)
i = i + 1
Range("J" & i) = Mid(DSat, k + 1, 9)
If Mid(DSat, 5, 13) = "[STX]8.8.1*2(" Then
k = InStr(1, DSat, "(", vbTextCompare)
i = i + 1
Range("T" & i) = Mid(DSat, k + 1, 9)

If Mid(DSat, 5, 13) = "[STX]8.8.1*1(" Then
k = InStr(1, DSat, "(", vbTextCompare)
i = i + 1
Range("D" & i) = Mid(DSat, k + 1, 9)
If Mid(DSat, 5, 13) = "[STX]8.8.2*1(" Then
k = InStr(1, DSat, "(", vbTextCompare)
i = i + 1
Range("K" & i) = Mid(DSat, k + 1, 9)
If Mid(DSat, 5, 13) = "[STX]8.8.2*2(" Then
k = InStr(1, DSat, "(", vbTextCompare)
i = i + 1
Range("U" & i) = Mid(DSat, k + 1, 9)

If Mid(DSat, 5, 13) = "[STX]8.8.3*1(" Then
k = InStr(1, DSat, "(", vbTextCompare)
i = i + 1
Range("L" & i) = Mid(DSat, k + 1, 9)
If Mid(DSat, 5, 13) = "[STX]8.8.3*2(" Then
k = InStr(1, DSat, "(", vbTextCompare)
i = i + 1
Range("V" & i) = Mid(DSat, k + 1, 9)


Range("B" & i) = j
End If
Wend

End If

End With
Application.ScreenUpdating = True

MsgBox "İşlem tamlanmıştır....", vbInformation, "N. YEŞERTENER --> www.excel.web.tr"

End Sub
İstediklerimi kodlara entegre edemedim
istediklerim
1) Veri çekeceğim dosyalar (metin belgeleri) yaklaşık 50 adet bir klosör içerisinde ve herbir metin belgesinden 20 adet (kodlara eklen) veri çekilecek çekilen veriler excel sayfasının kodlarda eklenen ilgili yerlere eklenmesini
2) veri çekilen metin belgesi ne ad ile kayıtlıysa excel sayfasının A2 hücresinden başlayarak A sutununda alt alta sıralanması gerekmektedir
3) Veri çekilecek metin belgelerinin bulunduğu klosörü aktar butonuna bastığımızda açılan pencereden klosöre ulaşıp okeyledikten sonra verileri çekmesi
Ekte örnek dosya gönderiyorum Aktar adlı dosyanın kodlarını inceleyebilirmisiniz
ekli dosyada satır ve karakter sayısına göre veri çekmektedir tüm özellikleri mümkün olduğu kadar aynı olmasını istiyorum tek fark birinde satırsayısına göre veri çekerken diğerinde tarama yapıp verilen kritere göre veri çekmesidir sizin kodları buna entegre edebilirmiyiz
kusura bakma hocam uzun bir açıklama oldu.
Not: deneme yapabilmeniz için ekli dosyadada iki adet txt metin belgesi bulunmaktadır
iyi çalışmalar
 

Ekli dosyalar

Son düzenleme:
Ekli klasörün içindeki aktar dosyadaki sayfa2 ve sayfa3 deki komut düğmeleri ile veriler alınmakta

sayfa3 deki verileri kontrol ediniz buradaki gibimi verileri almak istiyorsunuz.
 

Ekli dosyalar

Merhaba,

Bir inceleyiniz bakalım.

Kod:
Sub Dosyadan_Getir()
    Dim fd      As FileDialog, _
        Dosya, _
        Yol     As String, _
        Evet    As String, _
        i       As Long, _
        j       As Integer, _
        k       As Integer, _
        Son     As Long, _
        Satir   As String
    
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    
    With fd
        .Title = "Metin (Text) Dosyaların Olduğu Dizini Seçiniz"
        If .Show Then
            'Dizin seçildi, Yol belirlendi
            Yol = .SelectedItems(1) & Application.PathSeparator
        Else
            'Dizin seçilmekten vazgeçildi, program durduruluyor
            MsgBox "Dosya Seçilmedi..."
            Exit Sub
        End If
    End With
    
    Application.ScreenUpdating = False
    
    Son = Cells(Rows.Count, "A").End(3).Row
    If Son < 2 Then Son = 2
    Range("1:" & Son).ClearContents
    
    Dosya = Dir(Yol & "*.txt*")
    i = 1
    'Dizin seçildikten sonra dosyalar değerlendirilecek
    While Not Dosya = ""
        Evet = MsgBox(Dosya & " Dosyasını Kabul Ediyor Musunuz? ", vbYesNo, "Necdet YEŞERTENER")
        If Evet = vbYes Then
            i = i + 1
            Cells(i, "A") = Dosya
            Open Dosya For Input As #1
            j = 1
            While Not EOF(1)
                Line Input #1, Satir
                If Mid(Satir, 5, 12) = "[STX]1.8.1*1" Then
                    k = InStr(1, Satir, "(", vbTextCompare)
                    j = j + 1
                    Cells(i, j) = Mid(Satir, k + 1, 9)
                End If
            Wend
            Close #1
        End If
        Dosya = Dir
    Wend
     
    Application.ScreenUpdating = True
    MsgBox "İşlem tamlanmıştır....", vbInformation, "N. YEŞERTENER --> [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
 
End Sub
 

Ekli dosyalar

Merhaba Halit bey
Merhaba Necdet bey
ilgilineze çok teşekkür ederim

Necdet bey gönderdiğiniz dosyayı inceledim
B sutuna gelen veri
If Mid(Satir, 5, 12) = "[STX]1.8.1*1" Then
k = InStr(1, Satir, "(", vbTextCompare)
j = j + 1
Cells(i, j) = Mid(Satir, k + 1, 9)
doğru alıyor yalnız bunun 20 kriter için ayrı ayrı verileri getirmesi gerekiyor( bunu denedim yapamadım ) ayrıca klosör seçimi yapıldıktan sonra dosya seçimini sormayacak tüm txt dosyalarındaki bilgileri alması gerekmektedirAyrıca silme işi Range("1:" & Son).ClearContents değilde (A2:V) olacaktır

Halit bey gönderdiğiniz dosyada sayfa2 deki aktarma şeklindeki aktarma istiyorum
Burdatesbit edilen bazı aksaklıklar
1) x firmasının
[STX]0.0.0(09040924)[ETX]0 satırındaki veri aktarırken "09040924" sayısal veriyi "090409240" şeklinde sonuna sıfır ekliyerek aktarıyor Bu veriyi olduğu gibi herhangi bir eklenti veya eksik (sıfır dahil) yapmadan aktarması gerekiyor bu çok önemlidir
2)[STX]1.6.0*1(000.364*kW)(11-05-25,22:00)[ETX] satırdaki alınması gereken veri "000.364" iken "11052200 "alıyor
ekte örnekx adlı dosya gönderiyorum
örnek dosyanın 1. satırına alınacak verilerin aranacak kriterleri yazıldı 1. satırdaki hücrelerde yazılı kritere ait alınacak veri hemen altındaki(2.satırda)hücreye gelmesi gerekmektedir(1. satıra yazılan kriterler aktarımda kullanılmayacak verilerin hangi hücreye aktarılması gerektiğini göstermek için yazılmıştır.
Not: halit hocam kodlarınızda alınan veri sayısı 21 olarak yazılmış bu 20 olarak düzeltildi.Ayrıca C-D-E hücrelerine aktarılan veride bir yanlışlık var
iyi çalışmalar
 

Ekli dosyalar

Son düzenleme:
Merhaba Halit bey
Merhaba Necdet bey
ilgilineze çok teşekkür ederim

Necdet bey gönderdiğiniz dosyayı inceledim
B sutuna gelen veri
If Mid(Satir, 5, 12) = "[STX]1.8.1*1" Then
k = InStr(1, Satir, "(", vbTextCompare)
j = j + 1
Cells(i, j) = Mid(Satir, k + 1, 9)
doğru alıyor yalnız bunun 20 kriter için ayrı ayrı verileri getirmesi gerekiyor ayrıca klosör seçimi yapıldıktan sonra dosya seçimini sormayacak tüm txt dosyalarındaki bilgileri alması gerekmektedirAyrıca silme işi Range("1:" & Son).ClearContents değilde (A2:V) olacaktır

Halit bey gönderdiğiniz dosyada sayfa2 deki aktarma şeklindeki aktarma istiyorum
Burdatesbit edilen bazı aksaklıklar
1) x firmasının
[STX]0.0.0(09040924)[ETX]0 satırındaki veri aktarırken "09040924" sayısal veriyi "090409240" şeklinde sonuna sıfır ekliyerek aktarıyor Bu veriyi olduğu gibi herhangi bir eklenti veya eksik (sıfır dahil) yapmadan aktarması gerekiyor bu çok önemlidir
2)[STX]1.6.0*1(000.364*kW)(11-05-25,22:00)[ETX] satırdaki alınması gereken veri "000.364" iken "11052200 "alıyor
ekte örnekx adlı dosya gönderiyorum
örnek dosyanın 1. satırına alınacak verilerin aranacak kriterleri yazıldı 1. satırdaki hücrelerde yazılı kritere ait alınacak veri hemen altındaki(2.satırda)hücreye gelmesi gerekmektedir(1. satıra yazılan kriterler aktarımda kullanılmayacak verilerin hangi hücreye aktarılması gerektiğini göstermek için yazılmıştır.
Not: halit hocam kodlarınızda alınan veri sayısı 21 olarak yazılmış bu 20 olarak düzeltildi.
iyi çalışmalar

ekli dosyanızı kontrol ediniz.
 

Ekli dosyalar

Merhaba halit hocam
Cevabı elimde olmayan bazı nedenlerle geciktirdim kusura bakma
17 nolu mesajda gönderdiğiniz dosyayı inceledim 16 nolu mesajımdaki 1. şıktaki "090409240" "09040924"olayını çözmüşsünüz (sonuna eklenen sıfır olayını)
Şimdi x firmasını örnek aldığımızda
2. şıkta bahsettiğim )"[STX]1.6.0*1(000.364*kW)(11-05-25,22:00)[ETX]" olayında veri "000.364 "gelmesi gerkirken"11052200" geliyor

Birde hocam gönderdiğiniz excel dosyasında veri aktardığımızda1. satıra gelen [STX]0.0.0(09040924)[ETX]0 şeklindeki gelen tüm veriler gelmeyecek bu yanlış anlaşılmış galiba 2.satıra gelecek olan verilerin hangi hücreye geleceğini belirtmek için yazmıştım galiba yanlışım varsa düzeltin "Cells(1, sut2).Value = aranan(m)" pasif yapınca düzeliyor
hocam verileri aktarırken istediğim hücreye getirmek için
Dim aranan(20)
aranan(1) = "[STX]0.0.0": aranan(2) = "[STX]1.8.1*1": aranan(3) = "[STX]1.8.2*1":
aranan(4) = "[STX]1.8.3*1": aranan(5) = "[STX]5.8.1*1": aranan(6) = "[STX]5.8.2*1":
aranan(7) = "[STX]5.8.3*1": aranan(8) = "[STX]8.8.1*1": aranan(9) = "[STX]8.8.2*1":
aranan(10) = "[STX]8.8.3*1": aranan(11) = "[STX]1.6.0*1": aranan(12) = "[STX]1.8.1*2":
aranan(13) = "[STX]1.8.2*2": aranan(14) = "[STX]1.8.3*2": aranan(15) = "[STX]5.8.1*2":
aranan(16) = "[STX]5.8.2*2": aranan(17) = "[STX]5.8.3*2": aranan(18) = "[STX]8.8.1*2":
aranan(19) = "[STX]8.8.2*2": aranan(20) = "[STX]8.8.3*2":
Dim say, a, son1, b, t, y, sut2 şeklinde düzenleyince istediğim hücreye aktarıyor


Hocam veriler 2. satırdan başlamasını istiyordum onuda
Loop
Close
sut2 = 2'yi 3 yaptım yaptığım inşallah doğrudur.

Hocam çözemediklerim;
"[STX]1.6.0*1(000.364*kW)(11-05-25,22:00)[ETX]" olayında veri "000.364 "gelmesi gerkirken"11052200" geliyor bunu çözemedim


Halit bey dikkatimi çeken bir meselede bütün dosyalardan 20 adet veri çekmesi gerekiyorken gönderdiğiniz dosyada x firmasından 18 veri y firmasından 20 veri çekmektedir
y firmasının bütün verilerini eksiksiz aktarmış

x firmasının
aranan(18) = "[STX]8.8.2*2":verisi olan (00000.000) sayısal değer
aranan(17) = "[STX]8.8.2*1":verisi olan (00000.000) sayısal değer aktarmamış galiba sorun "00000.000" olan verilerde bunun bir çözümü varmı?

Hocam öğrenmek için soruyorum örn: "000.364" aktarması gerekirken "11052200" aktarıyor bunu kodlarda hangi kodda değişiklik yapıyorsunuz gösterebilirmisiniz?

hocam hakkını helal et iyi çalışmalar
 
Son düzenleme:
Burada aşağıda yazılı değerleri ben atlatıyordum bu değerler alınacakmı

" 000.000"
"00000.000"

sıralamayıda siz kendiniz yapacaksınız aşağıdaki aranan değerlerle

aranan(1) = "[STX]0.0.0": aranan(2) = "[STX]1.6.0*1": aranan(3) = "[STX]1.8.1*1":
aranan(4) = "[STX]1.8.1*2": aranan(5) = "[STX]1.8.2*1": aranan(6) = "[STX]1.8.2*2":
aranan(7) = "[STX]1.8.3*1": aranan(8) = "[STX]1.8.3*2": aranan(9) = "[STX]5.8.1*1":
aranan(10) = "[STX]5.8.1*2": aranan(11) = "[STX]5.8.2*1": aranan(12) = "[STX]5.8.2*2":
aranan(13) = "[STX]5.8.3*1": aranan(14) = "[STX]5.8.3*2": aranan(15) = "[STX]8.8.1*1":
aranan(16) = "[STX]8.8.1*2": aranan(17) = "[STX]8.8.2*1": aranan(18) = "[STX]8.8.2*2":
aranan(19) = "[STX]8.8.3*1": aranan(20) = "[STX]8.8.3*2":


burada aranan(1) ikinci sutüna aranan(2) üçüncu sutüna değerleri aktarıyor öncelik böyle gidiyor.

mesela

aranan(1) = "[STX]0.0.0"
yerine
aranan(20) = "[STX]0.0.0"
yaparsanız

buradaki "[STX]0.0.0" bu değeri arayıp bulduğu zaman yirminci sutüna atacaktır eğer birden fala bu değerle ilgili bilgi varsa sutünlar buna göre artarak kayacaktır.
 
Burada aşağıda yazılı değerleri ben atlatıyordum bu değerler alınacakmı

" 000.000"
"00000.000"

sıralamayıda siz kendiniz yapacaksınız aşağıdaki aranan değerlerle

aranan(1) = "[STX]0.0.0": aranan(2) = "[STX]1.6.0*1": aranan(3) = "[STX]1.8.1*1":
aranan(4) = "[STX]1.8.1*2": aranan(5) = "[STX]1.8.2*1": aranan(6) = "[STX]1.8.2*2":
aranan(7) = "[STX]1.8.3*1": aranan(8) = "[STX]1.8.3*2": aranan(9) = "[STX]5.8.1*1":
aranan(10) = "[STX]5.8.1*2": aranan(11) = "[STX]5.8.2*1": aranan(12) = "[STX]5.8.2*2":
aranan(13) = "[STX]5.8.3*1": aranan(14) = "[STX]5.8.3*2": aranan(15) = "[STX]8.8.1*1":
aranan(16) = "[STX]8.8.1*2": aranan(17) = "[STX]8.8.2*1": aranan(18) = "[STX]8.8.2*2":
aranan(19) = "[STX]8.8.3*1": aranan(20) = "[STX]8.8.3*2":


burada aranan(1) ikinci sutüna aranan(2) üçüncu sutüna değerleri aktarıyor öncelik böyle gidiyor.

mesela

aranan(1) = "[STX]0.0.0"
yerine
aranan(20) = "[STX]0.0.0"
yaparsanız

buradaki "[STX]0.0.0" bu değeri arayıp bulduğu zaman yirminci sutüna atacaktır eğer birden fala bu değerle ilgili bilgi varsa sutünlar buna göre artarak kayacaktır.

Merhaba halit hocam
" 000.000"
"00000.000"
evet bu değerlerde alınacak
hocam diğer bir sorunda örn; x firmasına ait txt metin belgesinde 29. satırda bulunan (satır sayısı değişebiliyor)
< [STX]1.6.0*1(000.364*kW)(11-05-25,22:00)[ETX][STX]
ve aranan(2) = "[STX]1.6.0*1": kriterine göre alınacak veri "000.364" olması gerekirken "11-05-25,22:00 "tresiz hali olan"1105252200 " alıyor bu neden kaynaklanıyor " 000.000" atlatıldığı içinmi bunu nasıl çözeriz

"burada aranan(1) ikinci sutüna aranan(2) üçüncu sutüna değerleri aktarıyor" olayı tamam bir önceki mesajdaki gibi düzenleme yaptım istediğim hücreye aktarıyor
Yukarıda bahsettiğim iki sorun çözüme kavuşursa işlem tamam olacak
iyi çalışmalar
 
Geri
Üst