• DİKKAT

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

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

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.
 
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
 
Ü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.
 
Ü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
 
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
 
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
 
Sn. @Necdet hocam çok teşekkür ederim, tam istediğim gibi oldu. Elinize sağlık. Hayırlı ramazanlar.
 
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

Geri
Üst