Sayfadaki Belirli Verileri Arayarak Gruplar Halinde Renklendirmek

[qazxswedc321]

Üstadlarım Ustalarım Merhaba,

Elimde düz yazı halinde bilgiler var. Bu bilgilerin içinde kelime ve rakamlar bulunmaktadır. Bu verilerin içerisinden istediğim veri gruplarını farklı punto ve renklerde bulmak istiyorum.

Bu konuda yardımlarınızı rica ederim.

Ekte örnek dosya verilmiştir.

NOT: Konumuzun kısmen dışarısında ama işin içerisinde makro olduğu için soruyorum; bu problem word'de makro yazılarak da çözülebilir mi?

Saygılar Sevgiler

 

[dEdE]

Merhaba,
Aşağıdaki linki inceler misiniz?
http://www.excel.web.tr/f50/cumlenin-belli-bir-bolumunun-reklendirilmesi-t124609.html

 

[qazxswedc321]

Sayın "dEdE",

Çok teşekkür ederim yardımınız için, çok sağolun.

 

[qazxswedc321]

Sayın "dEdE",

Belirttiğiniz linkte bulunan örneği incelediğimde A2 hücresinde bulunan kelimeyi sadece C2 hücresinde, A3'te bulunan kelimeyi sadece C3'te vb arama yapıyor ve kırmızı renkte işaretliyor.

Bu makroyu A sütununda bulunan kelimeleri (veya rakamları) C sütununda arasın ve bulduklarını yine aynı şekilde kırmızı yazacak şekilde değiştirmemiz mümkün müdür?

Yazılı makro şu idi:

Private Sub Worksheet_Change(ByVal Target As Range)
For i = 2 To Range("A" & Rows.Count).End(3).Row
Cells(i, 3).Characters.Font.ColorIndex = 1
Set Aranan = Cells(i, 3).Find(Cells(i, 1).Value, , xlValues, xlPart)
If Not Aranan Is Nothing Then
p = WorksheetFunction.Search(Cells(i, 1), Cells(i, 3))
x = Len(Cells(i, 1).Value)
Cells(i, 3).Characters(p, x).Font.ColorIndex = 3
End If
Next
End Sub


Saygılar Sevgiler

 

[qazxswedc321]

Diğer üstadlarımın da yorumlarını rica ederim.

Saygılar Sevgiler

 

[dEdE]

Merhaba,
Aşağıdaki kodu dener misiniz?
B sütununa yazacağınız ölçütler. B1 den başlayarak B2, B3 şeklinde alt alta virgülle ayrılarak yazılmalıdır.
Örnek dosya ektedir.

Sub BulBoya()
On Error Resume Next
For k = 1 To 2
a = Split(Cells(k, 2), ",")
If k = 1 Then
    Renk = 3
    Else
    Renk = 5
End If
For i = 2 To Range("A" & Rows.Count).End(3).Row
    For j = LBound(a) To UBound(a)
        q = 1
        x = Len(a(j))
        Do
            p = WorksheetFunction.Search(a(j), Cells(i, 1), q)
            If p = 0 Then GoTo atla
            With Cells(i, 1)
                .Characters(p, x).Font.ColorIndex = Renk
                .Characters(p, x).Font.Bold = True
            End With
            q = p + x
            p = 0
atla:
        Loop While Not IsError(WorksheetFunction.Search(a(j), Cells(i, 1), q))
    Next j
Next i
Next k
End Sub

 

[qazxswedc321]

Sayın "dEdE",

İlginiz için gerçekten çok teşekkür ederim. Ancak problemi 4. konudaki gibi çözme şansımız var mıdır?

 

[dEdE]

Merhaba,
Aşağıdaki kodu dener misiniz?
A sütununa yazacağınız ölçütler bir üstteki mesaja ekli örnek dosyanın B süttunundaki gibi yazılmalıdır.

Sub BulBoya()
On Error Resume Next
For k = 1 To Range("A" & Rows.Count).End(3).Row
a = Split(Cells(k, 1), ",")
If k = 1 Then
    Renk = 3
    Else
    Renk = 5
End If
For i = 2 To Range("C" & Rows.Count).End(3).Row
    For j = LBound(a) To UBound(a)
        q = 1
        x = Len(a(j))
        Do
            p = WorksheetFunction.Search(a(j), Cells(i, 3), q)
            If p = 0 Then GoTo atla
            With Cells(i, 3)
                .Characters(p, x).Font.ColorIndex = Renk
                .Characters(p, x).Font.Bold = True
            End With
            q = p + x
            p = 0
atla:
        Loop While Not IsError(WorksheetFunction.Search(a(j), Cells(i, 3), q))
    Next j
Next i
Next k
End Sub

 

[qazxswedc321]

Sayın "dEdE",

İlgi ve alakanız için çok teşekkür ederim.

Sorunumun çözümüne yönelik ekte verilen dosya daha doğru olacaktır. Şöyle ki, A2 hücresindeki kelime (veya rakam) yalnızca C2 hücresinde, A3 hücresindeki kelime (veya rakam) yalnızca C3 hücresinde aranmakta ve varsa işaretlendirilmektedir.

Makroyu, A sütununda bulunan kelimeler (veya rakamlar) C sütununda varsa renklendirme yapılması şeklinde geliştirebilir miyiz?

Saygılar Sevgiler

 

[qazxswedc321]

Sayın "dEdE",

Yardımlarınız için çok teşekkür ederim. Kod düzgün çalışmakta, kopyalama sırasında yaptığım hatadan dolayı ilk etapta çalıştıramamıştım, özür dilerim.

Tekrar tekrar sağolun varolun.