Metin bulma

[sakaryavedat]

Arkadaşlar merhaba.

Metin işlemleri ile ilgili vba da bir desteğe ihtiyacım var .

C1 deki metini D1 içersinde ara var ise D1 deki metinin içersinden bulduğun kısmı kes E1 e yapıştır. Yok ise D1 in hücre rengini kırmızı yap

C1 deki metini F1 içersinde ara var ise F1 deki metinin içersinden bulduğun kısmı kes G1 e yapıştır. Yok ise F1 in hücre rengini kırmızı yap.

 

[Korhan Ayhan]

Selamlar,

Bu işlemi formül ile yapabilirsiniz. Eğer dosyanız ağırlaşırsa makro ile çözüm üretiriz.

E1 hücresine;

=YERİNEKOY(D1;C1;"")

 

[sakaryavedat]

Merhaba.

Cevabınız için teşekkür ediyorum fakat istediğim tam olarak bu değil.

Sorumu biraz daha farklı bir örnekle desteklersem.

İlk durum.
C1="ABASIYANIK"
D1="SAİT FAİK ABASIYANIK"

işlemden sonra ki durum şöyle olmalı
C1="ABASIYANIK"
D1="SAİT FAİK"
E1="ABASIYANIK"

eğer C1 deki "ABASIYANIK" D1 içersinde yok ise D1 in hücre rengini kırmızı yap

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub VERİLERİ_DÜZENLE()
    Dim X As Long
    
    Application.ScreenUpdating = False
    
    Columns(4).Interior.ColorIndex = xlNone
    Columns(6).Interior.ColorIndex = xlNone
    
    For X = 1 To Range("C65536").End(3).Row
        If InStr(1, Cells(X, "D"), Cells(X, "C")) > 0 Then
            Cells(X, "D").Replace What:=Cells(X, "C"), Replacement:=""
            Cells(X, "E") = Cells(X, "C")
        Else
            Cells(X, "D").Interior.ColorIndex = 3
        End If
        
        If InStr(1, Cells(X, "F"), Cells(X, "C")) > 0 Then
            Cells(X, "F").Replace What:=Cells(X, "C"), Replacement:=""
            Cells(X, "G") = Cells(X, "C")
        Else
            Cells(X, "F").Interior.ColorIndex = 3
        End If
    Next
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[sakaryavedat]

Teşşekürler.
işte bu. Emeğinize sağlık