Ctrl+F komutu

[ernglr]

Excel de ctrl+f komutunda excel dosyası içerisinde arama yaparken bulunan sonucun farklı renk olmasını nasıl sağlayabilirim.

Yardımcı olur musunuz ?

 

[Ömer]

Merhaba,

ctrl+f de aranan değeri yazdıktan sonra tümünü bul deyip ctrl+a yaparsanız bulunan değerleri seçmiş olursunuz, veriler seçiliyken menüden renklendirme yapmanız yeterli olur.

 

[ernglr]

Evet o yöntemi kullanmayı biliyorum ancak şöyle bir problemim var Excel üzerinde 6 haneli 500 adet farklı kod listesi gelmekte ben her kodu yazıp enter komutunu verdiğimde hücrenin farklı bir renk almasını istiyorum

 

[Ömer]

Küçük bir örnek dosya ekleyerek dosya içerisinden konuyu detaylı açıklarmısınız.

 

[ernglr]

Aşağıda görselde belirttiğim gibi ctrl+f komutundan Bul komutunu kullandığımda aratmış olduğum "AA550614" seri numarasının bulunduğu hücre farklı bir renk olmasını istiyorum.

 

[Ömer]

Makroyu çalıştırıp aradığınız değeri girin.

Sub Bul_Renklendir()

    Dim ara As String, c As Range, Adr As String
  
    ara = Application.InputBox("Aranan Değer", "Değer Renklendirme")
  
    If ara = "" Then Exit Sub
  
    Application.ScreenUpdating = False  

    Set c = Cells.Find(ara, , xlValues, xlWhole)
    If Not c Is Nothing Then
        Adr = c.Address
        Do
            c.Interior.ColorIndex = 6
            Set c = Cells.FindNext(c)
        Loop While Not c Is Nothing And c.Address <> Adr
    End If
  
    Application.ScreenUpdating = True
  
End Sub

 

[ernglr]

çok teşekkür ederim ilginiz ve alakanız için çok çok sağolun

 

[ernglr]

Bir sorum daha olucak kusura bakmayın sizide sürekli bu şekilde rahatsız ediyorum.
Ancak bir ricam daha var eğer imkanı varsa Seri Kod da yer alan sadece sayıları yazınca bulmasını sağlayabilir miyiz

 

[Ömer]

Sorunuzu anlayamadım, daha detaylı açıklarmısınız.

 

[ernglr]

Aşağıda ki görselde de belirttiğimi gibi seri numara sütununda yer alan kodda sadece rakamları yazarak bulmasını sağlayabilir miyiz
makroda gösterdiğim gibi sadece rakamların bulabilmesini sağlamak istiyorum.

 

[Ömer]

Set c = Cells.Find(ara, , xlValues, xlWhole)

yerine;

Set c = Cells.Find(ara)

Kullanabilirsiniz, fakat bu arama yazdığınız sayı aranan bölgede içinde tüm geçenleri işleme sokar.

Sanırım sadece A sütununda arama yapacaksınız. Eğer öyleyse bu tür bir hata alacağınızı sanmam.

Demek istediğim, 1 değerini arattığınızda 1 ve renklenir 13 de renklenir. Fakat sizin veriler ve aranan değer bu kapsamı sağlamadığı için etkilenmez diye düşünüyor. Veri yapınıza göre * ilavesi de yapılabilir.
Eğer bu durumlarda etkilenecek verileriniz varsa farklı çözüm sunmam gerekir.

Eğer arama sadece A sütununda olacaksa,

Set c = Cells. olan 2 bölümdeki Cells yerine [A:A] yazmanız daha doğru olacaktır.

 

[ernglr]

Şuanda yeni kodu dediğiniz gibi değiştirdim sadece hücre içinde ki sayısal verileri yazmam yeterli oldu birşey daha rica edicem ctrl+f komutunda hücreyi yazıp enter komutunu verdiğimde ekranın hücreye yönelmesini nasıl sağlaya biliriz

 

[Ömer]

If Not c Is Nothing Then

satırından sonra aşağıdaki satırı ilave edin. Bu şekilde fare aranan değerin bulunduğu ilk hücreye gider.
İstediğiniz bu sanırım.

c.Select

.

 

[ernglr]

Sub Bul_Renklendir()

Dim ara As String, c As Range, Adr As String

ara = Application.InputBox("Aranan Değer", "Değer Renklendirme")

If ara = "" Then Exit Sub

Application.ScreenUpdating = False

Set c = Cells.Find(ara)
If Not c Is Nothing Then
c.select
Adr = c.Address
Do
c.Interior.ColorIndex = 6
Set c = Cells.FindNext(c)
Loop While Not c Is Nothing And c.Address <> Adr
End If

Application.ScreenUpdating = True

End Sub




kodu yukarıda dediğiniz gibi güncelledim ancak dediğim gibi bulunan hücreyi seçiyor ancak seçili hücreye ekranın gitmesini yani alt+enter komutunu nasıl ekleyebiliriz

 

[Ömer]

İstediğiniz bu mu?

Sub Bul_Renklendir()

    Dim ara As String, c As Range, Adr As String
 
    ara = Application.InputBox("Aranan Değer", "Değer Renklendirme")
 
    If ara = "" Then Exit Sub
 
    Application.ScreenUpdating = False

    Set c = Cells.Find(ara)
    If Not c Is Nothing Then
        Adr = c.Address
        Do
            c.Interior.ColorIndex = 6
            Set c = Cells.FindNext(c)
        Loop While Not c Is Nothing And c.Address <> Adr
    End If
    c.Select
    SendKeys "{F2}", True
    SendKeys "%{ENTER}", True
    SendKeys "{NUMLOCK}", True
    Application.ScreenUpdating = True
 
End Sub

 

[ernglr]

Evet teşekkür ederim istemiş olduğum durum tam olarak da bu makroya kısa yol atayıp pratik bir şekilde işimi görmeye başladım peki makro çalıştırdıktan sonra seri numaramı aratıyorum tamam komutuna tıkladığımda makro kendini kapatmasa ctrl+f komutu gibi sürekli açık kalm ihtimali var mı

 

[netzone]

Merhaba,

Makronun ilk satırına [Sub Bul_Renklendir() altına] 10: , son satırına [End Sub üstüne] GoTo 10 yazıp deneyiniz.

İyi çalışmalar.

 

[ernglr]

Merhaba,

Makronun ilk satırına [Sub Bul_Renklendir() altına] 10: , son satırına [End Sub üstüne] GoTo 10 yazıp deneyiniz.

İyi çalışmalar.

teşekkür ederim istediğim durum oldu tek sorun şuanda daha öncede bahsettiğim gibi ekranın yazdığım rakamın bulunduğu hücreye yönelmesini istiyorum bir bilginiz var mı sizin kodlarınız ekleyince o komutu kullanmadım

 

[ernglr]

Sub Bul_Renklendir()

10:
Dim ara As String, c As Range, Adr As String

ara = Application.InputBox("Aranan Değer", "Değer Renklendirme")

If ara = "" Then Exit Sub

Application.ScreenUpdating = False

Set c = Cells.Find(ara)
If Not c Is Nothing Then
Adr = c.Address
Do
c.Interior.ColorIndex = 6
Set c = Cells.FindNext(c)
Loop While Not c Is Nothing And c.Address <> Adr
End If
c.Select
SendKeys "{F2}", True
SendKeys "%{ENTER}", True
SendKeys "{NUMLOCK}", True
Application.ScreenUpdating = True
GoTo 10

End Sub



Bu şekilde kodları güncelledim 10: ve GoTo 10 komutu makronun sürekli çalışmasını sağladı ancak şuanda sorun şu ki ekran bulunan hücreye gitmiyor 10 ve goto 10 eklmeden önce oluyordu

 

[netzone]

Merhaba @ernglr,

Evet belirttiğiniz gibi ekranı tekrar çağırdığınızda hücre içinden çıkmaktadır. Hücre içinden çıkıldıktan sonra ekranı çağırması için dinleyici ekledim.

Daha önce eklediğimiz satırları silip, sayfanın kod kısmına aşağıdaki kodları ekleyerek deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    Call Bul_Renklendir
End Sub

İyi çalışmalar.