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

[hamit]

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))))

 

[Korhan Ayhan]

Ne kadar satırdaki veride formülü kullanıyorsunuz?

 

[hamit]

Üstad minumum 800 satır.

 

[Korhan Ayhan]

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.

 

[hamit]

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.

 

[Korhan Ayhan]

Bu durumda makro kullanmanızı tavsiye ederim.

 

[hamit]

Teşekkürler üstad.

 

[hamit]

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

 

[Korhan Ayhan]

Deneyiniz.

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

 

[hamit]

Ü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.

 

[Korhan Ayhan]

Verdiği kodu deneyin. Çalışması gerekir.

 

[hamit]

Maalesef farklı harf olunca çalışmıyor. Dosyayı ekledim. Bir de bu dosyanın boyutu neden büyük acaba bilginiz var mı?5mb

 

[hamit]

Maalesef farklı harf olunca çalışmıyor. Dosyayı ekleyemedim. Dosyanın boyutu 5mb bu da ilginç. Örnek dosya bile 5mb nasıl oluyor anlamadım.

bank_trasfer_sablon_MAKRO_-_2.xlsm dosyasını indir - download

bank_trasfer_sablon_MAKRO_-_2.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

www.dosya.tc

 

[Korhan Ayhan]

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ü.

 

[Korhan Ayhan]

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.

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

 

[hamit]

Ü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ı.

 

[hamit]

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?

 

[Korhan Ayhan]

"Sup" sayfasında "A" sütununa aranacak verilerinizi eklerseniz sonuç alabilirsiniz.

 

[hamit]

Teşekkürler üstadım

 

[hamit]

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ı?