Soru Parantez içindeki kelimelere göre arka planı değiştirme

istanbulcahan

Altın Üye
Katılım
11 Ocak 2008
Mesajlar
1,386
Excel Vers. ve Dili
Office 365 (Türkçe)
Altın Üyelik Bitiş Tarihi
05-11-2024
Parantez içindeki kelimelere göre arka planın değiştirmesi nasıl yapılabilir. Yardımcı olurmusunuz.
 

Ekli dosyalar

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,269
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Aşağıdaki formülle parantez içinde veriyi bulabilirsiniz.

C++:
=YERİNEKOY(PARÇAAL(A2;BUL("(";A2)+1;255);")";"")
Gerisini koşullu biçimlendirme-formül bölümü ile halledebilirsiniz.
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,371
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Aşağıdaki kodları dener misiniz?

Kod:
Sub Renklendir()

    Dim Bs  As Integer, _
        Bt  As Integer, _
        Uz  As Integer, _
        Szc As String, _
        c   As Range, _
        i   As Long
    
    Columns("A:A").Interior.Pattern = xlNone
    
    For i = 2 To Cells(Rows.Count, "A").End(3).Row
        Bs = InStr(Cells(i, "A"), "(") + 1
        Bt = InStr(Cells(i, "A"), ")")
        Uz = Bt - Bs
        Szc = Mid(Cells(i, "A"), Bs, Uz)

        Set c = Range("E:E").Find(Szc, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then Cells(i, "A").Interior.Color = c.Offset(0, 1).Interior.Color
    Next i
        
End Sub
 

istanbulcahan

Altın Üye
Katılım
11 Ocak 2008
Mesajlar
1,386
Excel Vers. ve Dili
Office 365 (Türkçe)
Altın Üyelik Bitiş Tarihi
05-11-2024
Üstadım. Bilgisayardan office çalıştırıken visual basice kodları yazmayı ALT-F11 le hallediliyordu. Şimdi. Bilgisayara yükleme yapamadığım için office online kullanıyorum. Bu kısa yollar onlinede yok nasıl yapayım.
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,371
Excel Vers. ve Dili
Ofis 365 Türkçe
Üstadım. Bilgisayardan office çalıştırıken visual basice kodları yazmayı ALT-F11 le hallediliyordu. Şimdi. Bilgisayara yükleme yapamadığım için office online kullanıyorum. Bu kısa yollar onlinede yok nasıl yapayım.
Dediğiniz konuda bir fikrim yok malesef.

Verdiğim kodların RegExp ile çözümü aşağıda.

Kod:
 Sub Renklendir()
 
    Dim Szc As String, _
        i   As Long, _
        c   As Range, _
        regExp, _
        objMatches
        
    Set regExp = CreateObject("VBScript.RegExp")
  
    regExp.IgnoreCase = True
    regExp.Global = True
    regExp.Pattern = "\(([^\)]+)\)"
        
    Application.ScreenUpdating = False
    Range("A:A").Interior.Pattern = xlNone
    
    For i = 2 To Cells(Rows.Count, "A").End(3).Row
    
        If regExp.Test(Cells(i, "A").Text) Then
        
            Set objMatches = regExp.Execute(Cells(i, "A"))
            Szc = objMatches.Item(0).Submatches.Item(0)
            
            Set c = Range("E:E").Find(Szc, LookIn:=xlValues, LookAt:=xlWhole)
            If Not c Is Nothing Then Cells(i, "A").Interior.Color = c.Offset(0, 1).Interior.Color

        End If
        
    Next i

    Set regExp = Nothing
    Application.ScreenUpdating = True
    
End Sub
 

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,164
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Sn. @Necdet Bey, öncelikle elinize sağlık, parantez içinde değil de, E sütunundaki kelimelerden A sütununda içinde geçen var ise renklensin isteseydik nasıl yapabilirdik. Teşekkürler
Not: 5.mesajınızdaki cevaba göre; Renklenecek sayfanın Sayfa1, E sütunundaki renk tablosunu Sayfa2 de olmasını düşünürsek
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,371
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Aranan sözcüklerin sayfa2 de E sütununda renklerin ise F sütununda olduğu varsayılarak, aşağıdaki kodları deneyiniz.

Kod:
   Sub SozcukAraRenklendir()

    Dim Sh1 As Worksheet, _
        Sh2 As Worksheet, _
        c   As Range, _
        i   As Long, _
        Adr As String
        
    Application.ScreenUpdating = False
    
    Set Sh1 = Sheets("Sayfa1")
    Set Sh2 = Sheets("Sayfa2")
    
    Sh1.Range("A:A").Interior.Pattern = xlNone
    
    For i = 2 To Sh2.Cells(Rows.Count, "E").End(3).Row
        With Sh1.Range("A:A")
            Set c = .Find(Sh2.Cells(i, "E"), LookIn:=xlValues)
            If Not c Is Nothing Then
                Adr = c.Address
                Do
                    Sh1.Cells(c.Row, "A").Interior.Color = Sh2.Cells(i, "F").Interior.Color
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> Adr
            End If
        End With
    Next i
    
    Application.ScreenUpdating = True
    MsgBox "İşlem Tamamlanmıştır.....", vbInformation, "Excel.Web.Tr"
    
End Sub
 

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,164
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Sn. @Necdet hocam çok teşekkür ederim, tam istediğim gibi oldu. Elinize sağlık. Hayırlı ramazanlar.
 

istanbulcahan

Altın Üye
Katılım
11 Ocak 2008
Mesajlar
1,386
Excel Vers. ve Dili
Office 365 (Türkçe)
Altın Üyelik Bitiş Tarihi
05-11-2024
Aşağıdaki formülle parantez içinde veriyi bulabilirsiniz.

C++:
=YERİNEKOY(PARÇAAL(A2;BUL("(";A2)+1;255);")";"")
Gerisini koşullu biçimlendirme-formül bölümü ile halledebilirsiniz.
Bu konuda çok dağıldım. Formülü E3 e uyguluyorum. A2deKİ parantez içindeki kelime E3 e geliyor. Ancak koşullu biçimlendirme (mecburen libre office portable kullandığımdan) Biçim-Koşullara bağlı-Renk skalasında formülü uyguluyoruj, ancak burdan öte gidemiyorum.Kilitlendim.Kaldım.
Yardımcı olabilirmisiniz.
 

Ekli dosyalar

Üst