Soru Ara-Renklendir Kodlarını Düzenleme

[mustafa038]

herkese selamlar.
eklemiş olduğum dosyada anlatmaya çalıştığım gibi.
formül arama yapıyor ve eşleşen kelimeleri hücre içerisinde boyuyor.
fakat arama yaparken formül içeren hücredeki değerleri boyamoyr.
ve rakam olarak aramaları da bulmuyor.
şimdiden teşekkürler .
saygılar.

 

[Korhan Ayhan]

Eklediğiniz dosyada bir sorun olabilir mi?

Boyama falan olmuyor.

 

[mustafa038]

Eklediğiniz dosyada bir sorun olabilir mi?

Boyama falan olmuyor.

hocam merhabalar
aynene dediğiniz gibi yanlış dosyayı yüklemişim.
kusura bakmayın.
istediğim dosya ektedir.

 

[Korhan Ayhan]

Doğrudur. Formüllü hücrelerde renklendirme yapamazsınız. Değer olması gerekir.

 

[mustafa038]

Doğrudur. Formüllü hücrelerde renklendirme yapamazsınız. Değer olması gerekir.

teşekkürler
peki hocam rakam olarak aramaları bulması için yapılabilecek bir şey var mı acaba.
saygılarımla..

 

[Korhan Ayhan]

Neyi nerede bulmak istediğinizi tarif eder misiniz?

 

[mustafa038]

Neyi nerede bulmak istediğinizi tarif eder misiniz?

hocam tekrardan merhabalar;
benim istemiş olduğum
M sutununa girmiş olduğum değerleri ( rakam-harf )
ara bul butonu ile
D-E-F-G-H-J sütunlarında ki eşleşenleri bulup boyaması.
(hücre dolgu da olabilir değerler de boyanabilir farketmez)

teşekkürler.

 

[Korhan Ayhan]

I sütununda işlem yapılmayacak mı?

 

[mustafa038]

I sütununda işlem yapılmayacak mı?

aranacaklar içinde o da var hocam.
D-E-F-G-H-J ve I

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Bul_Renklendir()
    Dim Aranan As Variant, Alan As Range, Son As Long
    Dim X As Long, Bul As Range, Adres As String, Say As Long
   
    If WorksheetFunction.CountA(Range("M:M")) = 0 Then
        MsgBox "İşleme devam edebilmek için M sütununa aranan değer girmelisiniz!", vbCritical
        Exit Sub
    End If
   
    Son = Cells(Rows.Count, "M").End(3).Row
    If Son = 3 Then Son = 4
   
    Aranan = Range("M3:M" & Son).Value
   
    Set Alan = Range("D3:J" & Rows.Count)
   
    Alan.Interior.ColorIndex = xlNone
   
    For X = LBound(Aranan) To UBound(Aranan)
        If Aranan(X, 1) <> "" Then
            Set Bul = Alan.Find(Aranan(X, 1), , , xlWhole)
            If Not Bul Is Nothing Then
                Adres = Bul.Address
                Do
                    Say = Say + 1
                    Bul.Interior.ColorIndex = 6
                    Set Bul = Alan.FindNext(Bul)
                Loop While Not Bul Is Nothing And Bul.Address <> Adres
            End If
        End If
    Next
   
    If Say > 0 Then
        MsgBox Say & " adet veri bulundu ve renklendirildi.", vbInformation
    Else
        MsgBox "Aradığınız değerler bulunamadı!", vbCritical
    End If
End Sub

 

[mustafa038]

Deneyiniz.

Option Explicit

Sub Bul_Renklendir()
    Dim Aranan As Variant, Alan As Range, Son As Long
    Dim X As Long, Bul As Range, Adres As String, Say As Long
  
    If WorksheetFunction.CountA(Range("M:M")) = 0 Then
        MsgBox "İşleme devam edebilmek için M sütununa aranan değer girmelisiniz!", vbCritical
        Exit Sub
    End If
  
    Son = Cells(Rows.Count, "M").End(3).Row
    If Son = 3 Then Son = 4
  
    Aranan = Range("M3:M" & Son).Value
  
    Set Alan = Range("D3:J" & Rows.Count)
  
    Alan.Interior.ColorIndex = xlNone
  
    For X = LBound(Aranan) To UBound(Aranan)
        If Aranan(X, 1) <> "" Then
            Set Bul = Alan.Find(Aranan(X, 1), , , xlWhole)
            If Not Bul Is Nothing Then
                Adres = Bul.Address
                Do
                    Say = Say + 1
                    Bul.Interior.ColorIndex = 6
                    Set Bul = Alan.FindNext(Bul)
                Loop While Not Bul Is Nothing And Bul.Address <> Adres
            End If
        End If
    Next
  
    If Say > 0 Then
        MsgBox Say & " adet veri bulundu ve renklendirildi.", vbInformation
    Else
        MsgBox "Aradığınız değerler bulunamadı!", vbCritical
    End If
End Sub

@korhan bey öncelikle teşekkür ederim;
hücrenin arama yaptıktan sonra boyanması için birebir değilde içeriğin bir kısmınını bulması şeklindede boyanması mümkün mü
mesala
hücrede MUSTAFA ERİYEBİLİR var diyelim
arama sutununa (M) değer olarak mustafa veya eriye yazdığımda da seçilip boyanması mümkün mü?
küçük büyük harf eşleşmesi de olmasın mümkünse.
teşekkürler

 

[Korhan Ayhan]

7# nolu mesajınızdan alıntı;

(hücre dolgu da olabilir değerler de boyanabilir farketmez)

 

[mustafa038]

7# nolu mesajınızdan alıntı;

(hücre dolgu da olabilir değerler de boyanabilir farketmez)

hocam eğer olabilirde
ikisi birden olursa tadından yenmez

 

[Korhan Ayhan]

Sonuç olarak;

Hücre tamamen sarı olmayacak sadece bulunan kelime mi renklenecek? Yani karakterler renklenecek.

Bir de arama yöntemi içerir mantığı ile olacak.

Eğer talebiniz bunlarsa sayısal verileri metin olarak düzenlemeniz gerekecektir.

 

[mustafa038]

Sonuç olarak;

Hücre tamamen sarı olmayacak sadece bulunan kelime mi renklenecek? Yani karakterler renklenecek.

Bir de arama yöntemi içerir mantığı ile olacak.

Eğer talebiniz bunlarsa sayısal verileri metin olarak düzenlemeniz gerekecektir.

evet @korhan hocam öyle olacak.
sayfa da toplu sayısal verileri nasıl metin olarak düzenleyebilir miyim ?

 

[Korhan Ayhan]

Sayısal alanı seçin.
Veri menüsünden Metni Sütunlara Dönüştür işlemini açın.
İleri-İleri-Metin-Tamam adımlarını takip edin.

Bu şekilde sayısal hücreler metinsel verilere dönüşecektir.

 

[Korhan Ayhan]

Deneyin bakalım istediğiniz sonucu verecek mi?

Sayıları metin biçiminde düzenlediğinizi varsaydım.

Option Explicit

Sub Bul_Renklendir()
    Dim Aranan As Variant, Alan As Range, Son As Long, Say As Long
    Dim X As Long, Y As Integer, Bul As Range, Adres As String, Renk As Byte
    
    If WorksheetFunction.CountA(Range("M:M")) = 0 Then
        MsgBox "İşleme devam edebilmek için M sütununa aranan değer girmelisiniz!", vbCritical
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    Son = Cells(Rows.Count, "M").End(3).Row
    If Son = 3 Then Son = 4
    
    Aranan = Range("M3:M" & Son).Value
    
    Set Alan = Range("D3:J" & Rows.Count)
    
    Alan.Interior.ColorIndex = -4142
    Alan.Font.ColorIndex = -4105
    
    For X = LBound(Aranan) To UBound(Aranan)
        If Aranan(X, 1) <> "" Then
            Set Bul = Alan.Find(CStr(Aranan(X, 1)), , , xlPart)
            If Not Bul Is Nothing Then
                Adres = Bul.Address
                Do
                    Renk = 3
                    For Y = 1 To Len(Bul.Value)
                        If Mid(Bul.Value, Y, Len(Aranan(X, 1))) = CStr(Aranan(X, 1)) Then
                            Bul.Characters(Y, Len(Aranan(X, 1))).Font.ColorIndex = Renk
                            If Renk = 3 Then Renk = 5
                            Y = Y + Len(Aranan(X, 1)) - 1
                            Say = Say + 1
                        End If
                        If Len(Aranan(X, 1)) = Len(Bul.Value) Then Exit For
                    Next
                    Set Bul = Alan.FindNext(Bul)
                Loop While Not Bul Is Nothing And Bul.Address <> Adres
            End If
        End If
    Next
    
    Application.ScreenUpdating = True
    
    If Say > 0 Then
        MsgBox Say & " adet veri bulundu ve renklendirildi.", vbInformation
    Else
        MsgBox "Aradığınız değerler bulunamadı!", vbCritical
    End If
End Sub