ARA BUL KOD

[Erdinç FIRTINA]

Değerli Forum üyeleri,

Bir sayfanın belirli bir sütunundaki her bir hücrede yer alan metin içinden belirlenen bir sözcük ya da sözcük grubunu aratarak, bulundu ise bir başka sütunun aynı satırdaki hücresine "ZORUNLU" bulunamadı ise "ZORUNLU YOK" şeklinde yazılması,

yine aynı şekilde aynı sayfanın aynı sütunundaki her bir hücrede yer alan metin içinden belirlenen bir sözcük ya da sözcük grubunu aratarak, bulundu ise bir başka sütunun aynı satırdaki hücresine "SERBEST" bulunamadı ise "SERBEST YOK" şeklinde yazılması için userform altında yer alan bir kod düzenlenmesi konusunda yardımcı olabilir misiniz?

Örnek dosya ve açıklamalar ektedir.

Yardımlarınız için şimdiden teşekkürler...

 

[Muzaffer Ali]

Merhaba.
Butona aşağıdaki kodları kopyalayın.
Bir şart var Demneme sayfasının O sütunundaki her aranacak kelime arasında virgül olmak zorunda, örnekte olduğu gibi.

Private Sub CommandButton1_Click()
    Dim syfDeneme As Worksheet, syfVeri As Worksheet
    Dim SayVeri As Long, Bak As Long
    Dim Bul As Range
    Dim Kelimeler As Variant
    Dim BakKelime As Integer
   
    Set syfDeneme = ThisWorkbook.Worksheets("DENEME")
    Set syfVeri = ThisWorkbook.Worksheets("Sayfa14")
    For Bak = 2 To syfDeneme.Cells(Rows.Count, "O").End(xlUp).Row
        Kelimeler = Split(syfDeneme.Cells(Bak, "O"), ",")
        For BakKelime = 0 To UBound(Kelimeler)
            If Not syfDeneme.Cells(Bak, "P") = "ZORUNLU" Then
                Set Bul = syfVeri.Range("B:B").Find(what:=Kelimeler(BakKelime), lookat:=xlWhole)
                If Not Bul Is Nothing Then
                    syfDeneme.Cells(Bak, "P") = "ZORUNLU"
                Else
                    syfDeneme.Cells(Bak, "P") = "ZORUNLU YOK"
                End If
            End If
            If Not syfDeneme.Cells(Bak, "Q") = "SERBEST" Then
                Set Bul = syfVeri.Range("C:C").Find(what:=Kelimeler(BakKelime), lookat:=xlWhole)
                If Not Bul Is Nothing Then
                    syfDeneme.Cells(Bak, "Q") = "SERBEST"
                Else
                    syfDeneme.Cells(Bak, "Q") = "SERBEST YOK"
                End If
            End If
            If syfDeneme.Cells(Bak, "P") = "ZORUNLU" And syfDeneme.Cells(Bak, "Q") = "SERBEST" Then Exit For
        Next
    Next
    MsgBox "İşlem tamamlandı.",vbInformation
End Sub

 

[Erdinç FIRTINA]

Sayın Muzaffer Ali,
Yardımlarınız için çok çok teşekkür ederim. Yüreğinize, elinize sağlık...

 

[Erdinç FIRTINA]

Değerli forum üyeleri,

Forum üyesi Sayın Muzaffer Ali'nin hazırlamış olduğu kodlarla, yapmak istediğim kısmen gerçekleşti.
Şöyle ki; Sayfa14'ün "B" sütununda yer alan her hücredeki değeri , DENEME sayfası "O" sütununda yer alan her bir hücrede arama yapmak istiyordum.
Söz konusu Sayfa14 "B:B" sütununda yer alan herhangi bir veri, (yani sütundaki tüm verilerden herhangi biri) DENEME sayfası "O:O" sütunundaki ilk hücrede yer alıyorsa "P: P" sütunundaki karşılığına ZORUNLU yazılması eğer Sayfa14 "B:B" sütunundaki her hangi bir veri DENEME sayfası "O:O" sütunundaki ilk hücrede yoksa ZORUNLU YOK yazılması ve bu döngünün, "O:O" sütunundaki her satırdaki veriler için devam etmesi.

Yardımlarınız için çok teşekkürler !!!

 

[Erdinç FIRTINA]

Değerli üyeler,
Dosyam konusunda yardımcı olabilir misiniz?

 

[Erdinç FIRTINA]

Değerli üyeler,
Dosyam konusunda yardımcı olabilir misiniz?