• DİKKAT

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

Text İçeriğini Kıyaslama

  • Konbuyu başlatan Konbuyu başlatan Sa.NaL
  • Başlangıç tarihi Başlangıç tarihi
S

Sa.NaL

Katılım
18 Haziran 2008
Mesajlar
542
Excel Vers. ve Dili
2007 türkçe
Merhaba Benim excel uzmanı arkadaşlardan ricam:
Ben işyerinde makinadan text içine değerler alıyorum.Daha Sonra da onları excele alıyorum.Bu değerler tarih sırasına göre ekte text içinde vardır.Bu değerleri alırkende aşağıdaki kodları kullanıyorum.

Sub DosyaGetir()
Open "D:\KALİTE KONTROL BÖLÜMÜ\Biten Motorlar\RESULT01.Txt" For Input As #1
i = 2
While Not EOF(1)
Line Input #1, Veri
Sheets(2).Cells(i, "A") = Left(Veri, 10)
Sheets(2).Cells(i, "B") = Mid(Veri, 12, 3)
Sheets(2).Cells(i, "K") = Right(Veri, 5)
Sheets(2).Cells(i, "V") = Mid(Veri, 49, 3)
Sheets(2).Cells(i, "G") = Mid(Veri, 55, 2)
Sheets(2).Cells(i, "J") = Mid(Veri, 58, 5)
Sheets(2).Cells(i, "F") = Mid(Veri, 38, 5)
Sheets(2).Cells(i, "E") = Mid(Veri, 4, 4)
Sheets(2).Cells(i, "Y") = Mid(Veri, 15, 5)
Sheets(2).Cells(i, "M") = Mid(Veri, 25, 4)
Sheets(2).Cells(i, "O") = Mid(Veri, 43, 4)
Sheets(2).Cells(i, "P") = Mid(Veri, 18, 5)
Sheets(2).Cells(i, "S") = Mid(Veri, 31, 4)
Sheets(2).Cells(i, "T") = Mid(Veri, 36, 5)
i = i + 1
Wend
Close #1
End Sub

Sizden isteğim 99. tarih e gelince(yani 99. tarih girilmeye teşebbüs sırasında komut butonuna basılınca)
Msgbox"Hafıza Dolmuştur,Yeniden Yükleme Yapabilmek İçin Makinanın Hafızasını Resetleyiniz...!" diye hata vermesi böyle birşey yapılabilirmi? Yardımlarınızı bekler,şimdiden tşkler ederim...
 

Ekli dosyalar

  • Ek.txt
    Ek.txt
    603 bayt · Görüntüleme: 2
Selamlar,
Kodu aşağıdaki gibi dener misiniz?
Kod: 
Sub DosyaGetir()
Son >98 Then
MsgBox "Hafıza Dolmuştur,Yeniden Yükleme Yapabilmek İçin Makinanın hafızasını Resetleyiniz...!" 
Exit Sub
End If
Open "D:\KALİTE KONTROL BÖLÜMÜ\Biten Motorlar\RESULT01.Txt" For Input As #1
i = 2
While Not EOF(1)
Line Input #1, Veri
Sheets(2).Cells(i, "A") = Left(Veri, 10)
Sheets(2).Cells(i, "B") = Mid(Veri, 12, 3)
Sheets(2).Cells(i, "K") = Right(Veri, 5)
Sheets(2).Cells(i, "V") = Mid(Veri, 49, 3)
Sheets(2).Cells(i, "G") = Mid(Veri, 55, 2)
Sheets(2).Cells(i, "J") = Mid(Veri, 58, 5)
Sheets(2).Cells(i, "F") = Mid(Veri, 38, 5)
Sheets(2).Cells(i, "E") = Mid(Veri, 4, 4)
Sheets(2).Cells(i, "Y") = Mid(Veri, 15, 5)
Sheets(2).Cells(i, "M") = Mid(Veri, 25, 4)
Sheets(2).Cells(i, "O") = Mid(Veri, 43, 4)
Sheets(2).Cells(i, "P") = Mid(Veri, 18, 5)
Sheets(2).Cells(i, "S") = Mid(Veri, 31, 4)
Sheets(2).Cells(i, "T") = Mid(Veri, 36, 5)
i = i + 1
Wend
Close #1
Son = Son + 1
End Sub
 
Verdiğiniz kod için teşekkür ederim ama isterseniz bir deneyin istediğim şey bu değil ben excelin 99.satırına tarih eklersem bu sizin dediğiniz kod geçerli benim excele değerleri aldığım hücre adresleri hep aynı ben textin içeriğinin kıyaslanmasından söz etmeye çalıştım.
 
Ekteki texti denermisiniz

İçinde 100 adet tarih olan texti aşağıdaki kodlarla denermisiniz çalışıyorsa bilgi verirseniz sevinirim bende istediğim gibi çalışmıyorda;
If son > 98 Then
MsgBox "Hafıza Dolmuştur,Yeniden Yükleme Yapabilmek İçin Makinanın hafızasını Resetleyiniz...!"
Exit Sub
End If
Open "D:\RESULT01.Txt" For Input As #1
i = 2
While Not EOF(1)
Line Input #1, Veri
Sheets(2).Cells(i, "A") = Left(Veri, 10)
Sheets(2).Cells(i, "B") = Mid(Veri, 12, 3)
Sheets(2).Cells(i, "K") = Right(Veri, 5)
Sheets(2).Cells(i, "V") = Mid(Veri, 49, 3)
Sheets(2).Cells(i, "G") = Mid(Veri, 55, 2)
Sheets(2).Cells(i, "J") = Mid(Veri, 58, 5)
Sheets(2).Cells(i, "F") = Mid(Veri, 38, 5)
Sheets(2).Cells(i, "E") = Mid(Veri, 4, 4)
Sheets(2).Cells(i, "Y") = Mid(Veri, 15, 5)
Sheets(2).Cells(i, "M") = Mid(Veri, 25, 4)
Sheets(2).Cells(i, "O") = Mid(Veri, 43, 4)
Sheets(2).Cells(i, "P") = Mid(Veri, 18, 5)
Sheets(2).Cells(i, "S") = Mid(Veri, 31, 4)
Sheets(2).Cells(i, "T") = Mid(Veri, 36, 5)
i = i + 1
Wend
Close #1
son = son + 1
Not=Ekteki texti d sürücünüze koyunuz...
 
eki unutmuşum pardon:)

texti ekledim şimdiden tşkler
 

Ekli dosyalar

Kod: 
[COLOR="Red"]Dim Son As Integer[/COLOR]
Sub Dene()
If Son > 98 Then
MsgBox "Hafıza Dolmuştur,Yeniden Yükleme Yapabilmek İçin Makinanın hafızasını Resetleyiniz...!"
Exit Sub
End If
Open "D:\RESULT01.Txt" For Input As #1
i = 2
While Not EOF(1)
Line Input #1, Veri
Sheets(2).Cells(i, "A") = Left(Veri, 10)
Sheets(2).Cells(i, "B") = Mid(Veri, 12, 3)
Sheets(2).Cells(i, "K") = Right(Veri, 5)
Sheets(2).Cells(i, "V") = Mid(Veri, 49, 3)
Sheets(2).Cells(i, "G") = Mid(Veri, 55, 2)
Sheets(2).Cells(i, "J") = Mid(Veri, 58, 5)
Sheets(2).Cells(i, "F") = Mid(Veri, 38, 5)
Sheets(2).Cells(i, "E") = Mid(Veri, 4, 4)
Sheets(2).Cells(i, "Y") = Mid(Veri, 15, 5)
Sheets(2).Cells(i, "M") = Mid(Veri, 25, 4)
Sheets(2).Cells(i, "O") = Mid(Veri, 43, 4)
Sheets(2).Cells(i, "P") = Mid(Veri, 18, 5)
Sheets(2).Cells(i, "S") = Mid(Veri, 31, 4)
Sheets(2).Cells(i, "T") = Mid(Veri, 36, 5)
i = i + 1
Wend
Close #1
Son = Son + 1
End Sub
Kırmızı satırı eklemeyi unutmuşum. Bu şekilde dener misiniz?
Kod mantığı şöyle: Makroyu her çalıştırmanızda "Son" değeri 1 sayı artar ve 99'a geldiğinde uyarı verir. Dosya kapandığında son değeri sıfırlanır. Son yerine herhengi bir hücreye bu değeri atarsanız, dosya kapanışında da kaçıncı sırada olduğunuz kayıtlı kalır.
Kod: 
Sub Dene()
If [a1] > 98 Then
MsgBox "Hafıza Dolmuştur,Yeniden Yükleme Yapabilmek İçin Makinanın hafızasını Resetleyiniz...!"
Exit Sub
End If
Open "D:\RESULT01.Txt" For Input As #1
i = 2
While Not EOF(1)
Line Input #1, Veri
Sheets(2).Cells(i, "A") = Left(Veri, 10)
Sheets(2).Cells(i, "B") = Mid(Veri, 12, 3)
Sheets(2).Cells(i, "K") = Right(Veri, 5)
Sheets(2).Cells(i, "V") = Mid(Veri, 49, 3)
Sheets(2).Cells(i, "G") = Mid(Veri, 55, 2)
Sheets(2).Cells(i, "J") = Mid(Veri, 58, 5)
Sheets(2).Cells(i, "F") = Mid(Veri, 38, 5)
Sheets(2).Cells(i, "E") = Mid(Veri, 4, 4)
Sheets(2).Cells(i, "Y") = Mid(Veri, 15, 5)
Sheets(2).Cells(i, "M") = Mid(Veri, 25, 4)
Sheets(2).Cells(i, "O") = Mid(Veri, 43, 4)
Sheets(2).Cells(i, "P") = Mid(Veri, 18, 5)
Sheets(2).Cells(i, "S") = Mid(Veri, 31, 4)
Sheets(2).Cells(i, "T") = Mid(Veri, 36, 5)
i = i + 1
Wend
Close #1
[a1]= [a1] + 1
End Sub
Tabi; isteğinizi doğru anlamışsam bu geçerli. Daha farklı bir şey istiyorsanız, biraz daha açılamanız gerekli.
 
Ben kendimi anlatamıyorum vazgeçtim:( sizin yaptığınız şu beyefendi benim excelden anladığım kadarıyla bir excel sayfasında a1 hücresine veri attığımı düşünür gibi davranıp bana A1 den veriler A98 kadar gelip tam geçip 99 olmasına izin vermeden hatayı verdiriyorsunuz bende diyorumki ben verilerimi o şekilde sıralamıyorum size birazdan formuda ekte göndericem. Bizim işyerimizde araba motorunun silindir içi yenileştirildikten sonra silindir yüzey ölçümleri bir ööçlme cihazı ile alınır ölçme cihazı bu ölçümleri 99 taneye kadar text formatında hafızasında tutar bu bilgiler daha önce makinadan fiş halinde çıkartılıyordu ben baktımki makinanın seri port kablosu var ve bilgileride text formatında mademki bilgisayara atabiliyor bende textden onu işyerinde iso formlarımız içine almak için makro kullandım.Makinanın mantığı da şu her yeni ölçümde eski ölçümü 2.satıra atıyor makina tüm kayıtlar hafızasından silinebiliyor ama iş yoğunluğunda dolayı bu farkedilmediğinden atölyedeki işçiler 99.kayıtta sonra farkında olmadan her motorun silindir ölçülerini 99 dan sonra aynı giriyorlar çünkü makina text dosyasının 1.satırına artık yeni ölçümler kaydedemiyor dolayısıyla işçiler hep aynı ölçüleri alıyor ben de sizden isteğim text dosyası içinde bulunan kayıtlar 99. satıra geldiği an MsgBox "Hafıza Dolmuştur,Yeniden Yükleme Yapabilmek İçin Makinanın hafızasını Resetleyiniz...!" bu hatanın vermesi .siz hücrenin 99 a gelmesini kodluyorsunuz ben text dosyasının içindeki bilgiyi kıyaslamadan bahsediyorum.Yukarıda çağırılan adresler hep 1.satırı getiriyor excele ben 99.satırın okutulup dur bakalım orası boşluktan farklı olamaz farklı olursa malum hatamız versin valla bunda da açık anlatamam heralde:)
 
Son düzenleme:
form ekledim

Formum ekte bulunmaktadır.
 

Ekli dosyalar

  • Ek.xls
    Ek.xls
    94.5 KB · Görüntüleme: 5
Yukarıdaki yapıların içinde "i" değişkeni mevcut.
Döngü içine eklenecek i = 99 karşılaştırması işinize yaramıyor mu?
 
Allah aşkına sabahtan beri uyguluyorum olmuyor text ekimde yukarıda işyerindeki excel formum da ek olarak yukarıda uygularmısız kendi bigisayarınızda çalışacakmı aynen uyguluyorum ve okadar profesyonel değilim ama 7 aydır öğreniyorum ama ne yaptımsa olmadı
 
Kod: 
.
.
While Not EOF(1)
    Line Input #1, Veri
    Sheets(2).Cells(i, "A") = Left(Veri, 10)
    Sheets(2).Cells(i, "B") = Mid(Veri, 12, 3)
    Sheets(2).Cells(i, "K") = Right(Veri, 5)
    Sheets(2).Cells(i, "V") = Mid(Veri, 49, 3)
    Sheets(2).Cells(i, "G") = Mid(Veri, 55, 2)
    Sheets(2).Cells(i, "J") = Mid(Veri, 58, 5)
    Sheets(2).Cells(i, "F") = Mid(Veri, 38, 5)
    Sheets(2).Cells(i, "E") = Mid(Veri, 4, 4)
    Sheets(2).Cells(i, "Y") = Mid(Veri, 15, 5)
    Sheets(2).Cells(i, "M") = Mid(Veri, 25, 4)
    Sheets(2).Cells(i, "O") = Mid(Veri, 43, 4)
    Sheets(2).Cells(i, "P") = Mid(Veri, 18, 5)
    Sheets(2).Cells(i, "S") = Mid(Veri, 31, 4)
    Sheets(2).Cells(i, "T") = Mid(Veri, 36, 5)
     i = i + 1
     If i = 99 Then GoTo bitir
Wend
.
.
bitir:
MsgBox "mesaj"
.
.
.
 
Tamam Ben pes ettim ne yaptımsa olmadı zeki hocam zahmet olmazsa bana yapıp ekte gönderebilirmisiniz
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst