Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Makro-VBA
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Makro-VBA Makro veya VBA ile ilgili sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 21-07-2008, 11:35   #11
geren36
 
Giriş: 25/05/2007
Şehir: istanbul
Mesaj: 165
Excel Vers. ve Dili:
türkçe vista işletim sistemi excel2007 türkçe
Varsayılan

teşekkürler Sn Haluk,

istediğim sıonuca bu şekilde ulaşılabiliyor ancak, anladığım kadarıyla her bir satırdaki veriyi diğer dosyada da satır-satır arıyor; bulamazsa ilgili kaydı yaratıyor.

Bahsettiğim gibi (bir.txt) ve ( iki.txt ) dosyalarının her birinde yaklaşık 160.000 satır kayıt var. hal böyle olunca sonuca ulaşmak saatler alacaktır.

( bir.txt ) ' de bulunan bir kaydı (find, instr ya da search vb.) ile ( iki.txt ) dosyasının içinde aratıp, kayıt yoksa sonucu yazmasını sağlayamaz mıyız acaba ?

teşekkürler, iyi çalışmalar..
geren36 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 21-07-2008, 11:42   #12
Haluk
Özel Üye
 
Giriş: 07/07/2004
Şehir: Türkiye
Mesaj: 5,364
Excel Vers. ve Dili:
Office 2010 - İngilizce
Varsayılan

Denemeyi yaptığınızda kaç saatte sonucun çıktığını burada belirtirseniz sevinirim.

Ben de merak ettim....

.
__________________
Kod anlatılmaz,yazılır ! 🇹🇷
Haluk Çevrimiçi   Alıntı Yaparak Cevapla
Eski 21-07-2008, 11:56   #13
geren36
 
Giriş: 25/05/2007
Şehir: istanbul
Mesaj: 165
Excel Vers. ve Dili:
türkçe vista işletim sistemi excel2007 türkçe
Varsayılan

kısa bir dosyada yaptığım denemede olumlu sonuç aldım ancak her bir satırı 0,25 sn de arayıp sonucu bulsa; yaklaşık olarak 10 saat' tan fazla sürecektir.

Bu yüzden çalışmayı bu şekliyle başlatmadım.

tek seferde tüm dosya içinde arama yapacak şekilde geliştirebilirsek production ortamına alacağım ancak o zamana kadar aşağıdaki şekilde kullanmayı düşünüyorum (excel' e veri yazmak zorunda kalıyorum ki bu da 1,5 saattte bitiyor..)


Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub Test()
 
Open "C:\bir.txt" For Output As #4
son = y.[f1040000].End(3).Row
For i = 1 To son
Print #4, y.Range("F" & i).Value
Next i
Close #4
y.Range("F:F").ClearContents

Open "C:\iki.txt" For Input As #5
Do Until EOF(5)
Line Input #5, Data1
On Error Resume Next
t = WorksheetFunction.VLookup(Data1, y.Range("a:a"), 1, False)
If t = Data1 Then
GoTo 111
Else:
Print #3, Data1
111 End If
Loop

Close
End Sub
geren36 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 21-07-2008, 12:26   #14
İdris SERDAR
Moderatör
 
İdris SERDAR kullanıcısının avatarı
 
Giriş: 21/10/2005
Şehir: Ankara
Mesaj: 14,601
Excel Vers. ve Dili:
Excel, 2016 - İngilizce
Varsayılan

Alıntı:
geren36 tarafından gönderildi Mesajı Görüntüle
Herkese kolay gelsin,

elimizde iki tane ( .txt ) dosyası vardır. Bunların içindeki bilgileri biribilerinde aratıp, farkları üçüncü bir ( .txt ) dosyasına yazdırmak istiyorum. Tüm dosyalar ( c:\ ) nin altında konumlandırılmıştır.

Diğer bir anlatımla, (bir.txt) dosyasındaki verileri sırasıyla (iki.txt) dosyasında aratıp farkları (farklar.txt) dosyasına; (iki.txt) dosyasındaki verileri (bir.txt) dosyasında aratıp farkları (farklar.txt) dosyasına nasıl yazdıracağız acaba ?

Orijinal dosyaların her birinde 165000 kadar kayıt vardır. Bu nedenle buradaki önemli husus, ( .txt ) dosyalarındaki verilerin excel' e yazdırılmadan sonuca ulaşılmasıdır.

Örnek dosyalar ve sonuçta ulaşılmak istenen netice dosyası da ektekidir..

teşekkürler..
http://www.softinterface.com/MD/Docu...FRSb1QodxRAMkA

Buradaki dosya oldukça kullanışlı. İşinize yarayabilir.

.
__________________
Çalışmalarımı görmek için:

http://www.excelgurusu.com/

İdris SERDAR
İdris SERDAR Çevrimdışı   Alıntı Yaparak Cevapla
Eski 21-07-2008, 12:55   #15
Haluk
Özel Üye
 
Giriş: 07/07/2004
Şehir: Türkiye
Mesaj: 5,364
Excel Vers. ve Dili:
Office 2010 - İngilizce
Varsayılan

Kodda ufak bir değişiklik yaptıktan sonra verdiğiniz dosyalardaki satırları çoğaltıp, bir deneme yaptım.

Kodun çalışacağı PC'nin konfigürasyonuna bağlı olmakla birlikte, yaptığım denemede Bir.txt dosyasında 201.601 satır ve İki.txt dosyasında 190.514 satır veri varken, kodun çalışması 1 dakika 20 saniye sürdü.

Artık gerisini siz bilirsiniz...



Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub Test()
    'Haluk ®
    '21/07/08
    Dim TxtFile1 As String, TxtFile2 As String
    TxtFile1 = "C:\bir.txt"
    TxtFile2 = "C:\iki.txt"
    If Dir("C:\Farklar.txt") <> "" Then Kill "C:\Farklar.txt"
    Call CheckFiles(TxtFile1, TxtFile2)
    Call CheckFiles(TxtFile2, TxtFile1)
End Sub
'
Sub CheckFiles(File1 As String, File2 As String)
    Dim MyCheck As Boolean
    Open File1 For Input As #1
    Open "C:\Farklar.txt" For Append As #2
    Do While Not EOF(1)
        DoEvents
        Line Input #1, Data1
        Open File2 For Input As #3
        Do While Not EOF(2)
            MyCheck = False
            Line Input #3, Data2
            If Data2 = Data1 Then
                MyCheck = True
                Exit Do
            End If
        Loop
        Close #3
        If MyCheck = False Then Print #2, Data1
    Loop
    Close #2
    Close #1
End Sub
.
__________________
Kod anlatılmaz,yazılır ! 🇹🇷
Haluk Çevrimiçi   Alıntı Yaparak Cevapla
Eski 24-07-2008, 14:32   #16
geren36
 
Giriş: 25/05/2007
Şehir: istanbul
Mesaj: 165
Excel Vers. ve Dili:
türkçe vista işletim sistemi excel2007 türkçe
Varsayılan

Sn Yurttaş,

dosyayı indirdim. oldukça faydalı bir program ancak dosyalarımdaki veri çok olduğu için PC' m kilitleniyor. Yine de mesala word belgelerini karşılaştırırken çok işime yaradı.

Paylaşımınız için teşekkür ederim...

Sn Haluk,

Emeğiniz ve paylaşımınzı için size de çok teşekkür ederim. Ancak, yazmış olduğunuz kod, her iki dosyadaki veriler aynı satırda ise işe yaramaktadır. Aynı satır numarasına sahip olmayan verileri fark olarak yazmaktadır ki sonuç olarak fark.txt dosyasında 320.000 adet kadar kayıt oluşturmaktadır.

Sizin yol göstermeniz sayesinde kodu biraz daha değiştirdim ve matching şimdi 50 dk kadar sürmektedir. Biraz daha araştırma yapıyorum. Son durumu burada sizlerle tekrar paylaşacağım..

Kolay gelsin..
geren36 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 24-07-2008, 16:34   #17
Haluk
Özel Üye
 
Giriş: 07/07/2004
Şehir: Türkiye
Mesaj: 5,364
Excel Vers. ve Dili:
Office 2010 - İngilizce
Varsayılan

..........
__________________
Kod anlatılmaz,yazılır ! 🇹🇷

Bu mesaj en son " 24-07-2008 " tarihinde saat 17:22 itibariyle Haluk tarafından düzenlenmiştir.... Neden: Daha sonra düzenlenecek...
Haluk Çevrimiçi   Alıntı Yaparak Cevapla
Eski 25-07-2008, 10:58   #18
Haluk
Özel Üye
 
Giriş: 07/07/2004
Şehir: Türkiye
Mesaj: 5,364
Excel Vers. ve Dili:
Office 2010 - İngilizce
Varsayılan

Sanırım aşağıdaki kod bu sefer isteğinizi karşılayacak, ama uzun sürebilir.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub Test()
    'Haluk ®
    '25/07/08
    Dim TxtFile1 As String, TxtFile2 As String
    T1 = Now
    TxtFile1 = "C:\bir.txt"
    TxtFile2 = "C:\iki.txt"
    If Dir("C:\Farklar.txt") <> "" Then Kill "C:\Farklar.txt"
    Open "C:\Farklar.txt" For Append As #1
    Print #1, "Farklar"
    Print #1, "-------"
    Close #1
    Call CheckFiles(TxtFile1, TxtFile2)
    Call CheckFiles(TxtFile2, TxtFile1)
    T2 = Now
    MsgBox "Kodun çalışma süresi = " & Format(T2 - T1, "hh:mm:ss")
End Sub
'
Sub CheckFiles(File1 As String, File2 As String)
    Open File1 For Input As #1
        Do While Not EOF(1)
            DoEvents
            Line Input #1, Data1
            
            Open File2 For Input As #2
                    Do While Not EOF(2)
                        Line Input #2, Data2
                        If Data2 = Data1 Then GoTo 110:
                    Loop
                
                Open "C:\Farklar.txt" For Input As #3
                    Do While Not EOF(3)
                    Line Input #3, Data3
                        If Data3 = Data1 Then
                            Close #3
                            GoTo 110:
                        End If
                    Loop
                Close #3
                
                Open "C:\Farklar.txt" For Append As #3
                    Print #3, Data1
                Close #3
110:
            Close #2
        Loop
    Close #1
End Sub
__________________
Kod anlatılmaz,yazılır ! 🇹🇷
Haluk Çevrimiçi   Alıntı Yaparak Cevapla
Eski 29-07-2008, 12:12   #19
geren36
 
Giriş: 25/05/2007
Şehir: istanbul
Mesaj: 165
Excel Vers. ve Dili:
türkçe vista işletim sistemi excel2007 türkçe
Varsayılan

ilginize teşekkür ederim Sn Haluk,

malum iş-güç, ancak bakabildim mesajınıza..

en kısa sürede deneyip cevap döneceğim.

kolay gelsin..
geren36 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 26-01-2015, 11:10   #20
tamer42
Destek Ekibi
 
tamer42 kullanıcısının avatarı
 
Giriş: 11/03/2005
Şehir: Ankara
Mesaj: 1,185
Excel Vers. ve Dili:
Office 2013 İngilizce
Varsayılan

Merhabalar,
Haluk hocamın aşağıdaki verdiği kapalı "*.txt" dosyasında veri alma ile alakalı olarak; ben bazı düzenlemeler yaptım.

Burada sormak istediğim txt dosyasından yalnızca belirli bir satırdan veriyi nasıl alabiliriz?

Örnek: 4. satırdaki veriyi almak için nasıl bir düzenleme yapabiliriz?


Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
RS.RECORDS(3)
gibi...

teşekkürler, iyi çalışmalar.


Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub AdoTest()

    Dim a As String
    Dim FilePath As String
    Dim MyFile1 As String, MyFile2 As String
    Dim Conn As Object, RS As Object
    
    FilePath = "D:\Users\User\Documents\Excel Makro\"
    MyFile1 = "okubeni.txt"
    MyFile2 = "iki.txt"
    
    
    Set Conn = CreateObject("ADODB.Connection")
    
    Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & FilePath & ";Extended Properties=""text;HDR=No;IMEX=1;"""
    Set RS = CreateObject("ADODB.RECORDSET")
    
    RS.Open "select * from " & MyFile1, Conn, 3, 1, 1
    
 i = 1
 
        While Not RS.EOF
        

                If RS(0) Like "*ExcelVBA*" Then
                
                     a = Mid(RS(0), 9, 8)
                     
                     MsgBox a
                
                End If
        RS.movenext
        Wend
        
    Close #1
    
    RS.Close
    Conn.Close
End Sub
Eklenmiş Dosyalar
Dosya Türü: txt okubeni.txt (461 Byte, 7 Görüntülenme)
tamer42 Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 09:22


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım -- Beylikdüzü mali müşavir - Beylikdüzü mali müşavir - Lingerie - Dyeing Machine - Karton Bardak- Karton Bardak- Çorlu Dil Konuşma Terapisti- Çorlu Dil Konuşma Terapisti- Çorlu Konuşma Terapisti- Çorlu Konuşma Terapisti- Çorlu Özel Eğitim- Site Yönetimi- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Çorlu- Çorlu Araç Takip- Çorlu Su Arıtma- Gebze Emlak- Rampa- Rotary- Çorlu İnternet Sitesi- Çorlu Sürücü Kursu- Çorlu Sürücü Kursu- Şişli Avukat- Edirne Serbest Muhasebeci- Çorlu Etüt- İstanbul Botanik- Çorlu Sigorta- Kağıt Bardak- Kağıt Bardak- Kaplan Tekstil- Çorlu Perde- Çorlu Perde- Çorlu Havuz- Çorlu Havuz- Makina- Danışmazlar- Çorlu Perde Yıkama- Çorlu Perde Yıkama- Okul Danışmanlık- Çorlu Ayakkabı- İzmit Sigorta- ADR'li taşıma kabı imalatı- Mekanik Tesisat- Çorlu Grafik Tasarım-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden