• DİKKAT

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

Hücre içindeki cümle içinde, listede geçen kelimeyi bulma

H

hamit

Katılım
13 Ağustos 2004
Mesajlar
83
Excel Vers. ve Dili
2019
Merhaba
Hücre içinde cümle içinde, listede geçen kelimeyi bulmak için makro var ama formülle yapmak mümkün mü? Forumda Ctrl+shift+enter ile çalışan bir ara formülü var ancak sayfayı kitliyor. Ve çok ağır çalışıyor. Yardımlarınızı rica ederim. Daha önce oluşturulmuş makrolu dosyayı ekliyorum. Daha önce oluşturulan formül:

DOLAYLI("I"&MAK(EĞER(YERİNEKOY(KÜÇÜKHARF(J2);KÜÇÜKHARF($I$1:$I$40);"";1)=J2;0;SATIR($1:$40))))
 

Ekli dosyalar

Ne kadar satırdaki veride formülü kullanıyorsunuz?
 
Eklediğiniz formülde konular sayfasıyla bir bağ görünmüyor. Siz nasıl sonuç alabiliyorsunuz?

Veri sayınız fazla ise yavaşlık söz konusu olabilir. Bunun dışında dosyanız normal çalışıyor görünüyor.
 
Kullandığım formül aynı. Data büyük olduğu için koymadım. Formülde düzetmeler yaparak kendime uyarladım. Evet veri fazla.
 
Bu durumda makro kullanmanızı tavsiye ederim.
 
Korhan Üstadım. Makroda büyük küçük harfe duyarlı. Bunu büyük küçük harf duyarsız nasıl yapabiliriz?



Sub KELİME_ARA()
Dim S1 As Worksheet, S2 As Worksheet
Dim X As Long, Y As Integer

Set S1 = Sheets("Sup")
Set S2 = Sheets("data")

For X = 2 To S2.Range("A65536").End(3).Row
For Y = 2 To S1.Range("A65536").End(3).Row
If InStr(1, S2.Cells(X, "G"), S1.Cells(Y, "D")) > 0 Then
S2.Cells(X, "H") = S1.Cells(Y, "A")
GoTo Devam
End If
Next
Devam:
Next

Set S1 = Nothing
Set S2 = Nothing

MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Deneyiniz.

Kod: 
Sub KELİME_ARA()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim X As Long, Y As Integer
    Dim Veri As String, Aranan As String
    
    Set S1 = Sheets("Konular")
    Set S2 = Sheets("Sayfa1")
    
    For X = 2 To S2.Range("A65536").End(3).Row
        For Y = 2 To S1.Range("A65536").End(3).Row
            Veri = UCase(Replace(Replace(S2.Cells(X, "C"), "ı", "I"), "i", "İ"))
            Aranan = UCase(Replace(Replace(S1.Cells(Y, "A"), "ı", "I"), "i", "İ"))
            If InStr(1, Veri, Aranan) > 0 Then
                S2.Cells(X, "F") = S1.Cells(Y, "A")
                GoTo Devam
            End If
        Next
Devam:
    Next
    
    Set S1 = Nothing
    Set S2 = Nothing
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Üstad tüm harfler de bunu yapmak için harflerin hepsini yazmalı mı? Yoksa başka seçenek var mı?

Veri = UCase(Replace(Replace(S2.Cells(X, "C"), "ı", "I"), "i", "İ", "a", "A", "m", "M"))
Aranan = UCase(Replace(Replace(S1.Cells(Y, "A"), "ı", "I"), "i", "İ", "a", "A", "m", "M"))

bu şekilde yapınca "... bir söz dizimi hatası nedeniyle çalıştırılamıyor" diyor.
 
Verdiği kodu deneyin. Çalışması gerekir.
 
Maalesef farklı harf olunca çalışmıyor. Dosyayı ekledim. Bir de bu dosyanın boyutu neden büyük acaba bilginiz var mı?5mb
 
Son düzenleme:
Boyut problemi boş gibi görünen fakat kullanılmış satırlardan kaynaklanıyor.

Son eklediğiniz dosyada "data" sayfasında 27. satır ve sonrasını mouse seçip SİL komutunu çalıştırın. Uzun sürebilir. Sonrasında dosyanızı kaydedin. Boyutu küçülecektir.

Ben uyguladığımda dosyanız 22 KB olarak küçüldü.
 
Ek olarak eklediğiniz dosyada sütunların yeri değişmiş. Kodun çalışmaması normaldir. Kod "C" sütunundaki veriye göre yazılmıştı. Şimdi ki dosyanızda "G" sütununa kaydırılmış.

Sürekli tekrarlıyoruz ama üyelerimiz maalesef bu huylarından bir türlü vazgeçmiyorlar.

Eklediğiniz dosyalar gerçek dosyanızla aynı yapıda (satır-sütun bilgileri) olsun diye. Ama nafile...

Sağlıklı sonuç alabilmeniz için dosyanızın nihai yapısına (satır-sütun bakımından) karar vermelisiniz.

Son dosyanıza göre aşağıdaki kodu kullanabilirsiniz.

Kod: 
Option Explicit
 
Sub KELİME_ARA()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim X As Long, Y As Integer
    Dim Veri As String, Aranan As String
    
    Set S1 = Sheets("Sup")
    Set S2 = Sheets("data")
    
    For X = 3 To S2.Range("A65536").End(3).Row
        Veri = UCase(Replace(Replace(S2.Cells(X, "G"), "ı", "I"), "i", "İ"))
        For Y = 1 To S1.Range("A65536").End(3).Row
            Aranan = UCase(Replace(Replace(S1.Cells(Y, "A"), "ı", "I"), "i", "İ"))
            If InStr(1, Veri, Aranan) > 0 Then
                S2.Cells(X, "H") = S1.Cells(Y, "A")
                GoTo Devam
            End If
        Next
Devam:
    Next
    
    Set S1 = Nothing
    Set S2 = Nothing
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Üstad çok teşekkür ederim. Ellerinize sağlık. Evet Orjinali yükledim orada daha doğru çalıştı. Dediğiniz gibi hata sütundan kaynaklı.
 
Korhan bey tekrar rahatsız ediyorum kusura bakmayın "Sup" veriler eklediğimde o verileri arama yapmıyor. Sadece ilk 6 satırdakini arıyor. Bu liste sürekli güncellenecek acaba sütunun tamamı şeklinde bir arama yapılabilir mi?
 
"Sup" sayfasında "A" sütununa aranacak verilerinizi eklerseniz sonuç alabilirsiniz.
 
Korhan üstad merhaba. Makro güzel çalışıyor tekrar ellerinize sağlık. 3500 satırlık bir veride yavaş çalışıyor. Veri işlenmesinden de olabilir. Acaba hızlandırma imkanımız var mı?
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst