ara bul renklendir

[mustilem23]

merhabalar,

ara bul renklendir olarak bir forumdan bulduğum kodlar mevcut fakat tüm exceller de kullanamıyorum ,tüm excellerde kullanabilmek için yardımcı olabilir misiniz.


kullandığım kod.

Sub Bul_Renklendir()
Dim neyi As String, rng As Range, alan As Range
neyi = Application.InputBox("A120 hücrelerinde, bulmak istediğiniz veri", , "")
Set alan = Range("A120")
alan.Interior.ColorIndex = xlNone
For Each rng In alan
If StrConv(rng, vbProperCase) = StrConv(neyi, vbProperCase) Then
rng.Interior.ColorIndex = 35
End If
Next rng
Set alan = Nothing
End Sub

 

[Asri]

Kodda biraz değişiklik yaptım.
Arama kelimesinden sonra bir soru daha soruyor, arama içerir mi olsun, birebir eşleme yöntemi ilemi diye.

Arama alanını genişletmek için buradaki değeri değiştirin.
Set alan = Range("A120")


1. Geliştirici menüsü ekleme

* Excel ana menülerde Geliştirici var mı bakalım.
* Yok ise ikonların üzerinden sağ tuş şerisi özelleştir diyelim
* Ana sekmeler bölümünde "Geliştirici" ti işaretleyip tama diyelim.

2. Personal makrolarına erişim

* Excel geliştirici ekranında makro kaydet deyin.
* Makronun adını bir yere not alın. "Makro 1" gibi.
* Makronun saklancağı yeri "Kişisel Makro Çalışma Kitabı" seçin. Tamam deyin.
* Bir hücre seçip durdur deyin
* VBA editörüne geçin. PERSONAL.XLSB nin + sını tıklayın açılsın.
* Modüles in + sını tıklayın açılsın.
* Modul1 , Modul2 gibi isimler göreceksiniz.
* Tüm modüllere bakıp not aldığınız makro yu bulun.
* Bulduğunuz makroyu silip, kendi makronuzu yapıştırın.
* Yukardan kaydet deyin.
* Makronuz tüm excel dosyalarında çalışacaktır.

3. Makro yu menülere ekleme

*Excel ikonlarından sağ tuş şeridi özelleştir deyin.
* Sekmeler bölümünde "Yeni Sekme" deyin.
* Komutlar kutusundan Makrolar başlığını seçin
* Kendi makronuzu bulup kulağından tutun ve yeni oluşturduğunuz sekmenin altındaki grubun altına bırakın.

Sub Bul_Renklendir()
  Dim neyi As String, rng As Range, alan As Range
  icerir = False
  neyi = Application.InputBox("A1:D20 hücrelerinde, bulmak istediğiniz veri", , "")
  If MsgBox("Arama içerir mi olsun?", vbYesNo) = vbYes Then
     icerir = True
  End If

  Set alan = Range("A1:D20")
  alan.Interior.ColorIndex = xlNone
  For Each rng In alan
      If StrConv(rng, vbLowerCase) Like "*" & StrConv(neyi, vbLowerCase) & "*" And icerir = True Then
          rng.Interior.ColorIndex = 35
      End If
      If StrConv(rng, vbLowerCase) = StrConv(neyi, vbLowerCase) And icerir = False Then
          rng.Interior.ColorIndex = 35
      End If
      
  Next rng
  Set alan = Nothing
End Sub

 

[hakanimamoglu]

Teşekkürler... Asri Bey

 

[mustilem23]

sayın asri çok teşekkürler.

 

[Erdogan3434]

Kodda biraz değişiklik yaptım.
Arama kelimesinden sonra bir soru daha soruyor, arama içerir mi olsun, birebir eşleme yöntemi ilemi diye.

Arama alanını genişletmek için buradaki değeri değiştirin.
Set alan = Range("A120")


1. Geliştirici menüsü ekleme

* Excel ana menülerde Geliştirici var mı bakalım.
* Yok ise ikonların üzerinden sağ tuş şerisi özelleştir diyelim
* Ana sekmeler bölümünde "Geliştirici" ti işaretleyip tama diyelim.

2. Personal makrolarına erişim

* Excel geliştirici ekranında makro kaydet deyin.
* Makronun adını bir yere not alın. "Makro 1" gibi.
* Makronun saklancağı yeri "Kişisel Makro Çalışma Kitabı" seçin. Tamam deyin.
* Bir hücre seçip durdur deyin
* VBA editörüne geçin. PERSONAL.XLSB nin + sını tıklayın açılsın.
* Modüles in + sını tıklayın açılsın.
* Modul1 , Modul2 gibi isimler göreceksiniz.
* Tüm modüllere bakıp not aldığınız makro yu bulun.
* Bulduğunuz makroyu silip, kendi makronuzu yapıştırın.
* Yukardan kaydet deyin.
* Makronuz tüm excel dosyalarında çalışacaktır.

3. Makro yu menülere ekleme

*Excel ikonlarından sağ tuş şeridi özelleştir deyin.
* Sekmeler bölümünde "Yeni Sekme" deyin.
* Komutlar kutusundan Makrolar başlığını seçin
* Kendi makronuzu bulup kulağından tutun ve yeni oluşturduğunuz sekmenin altındaki grubun altına bırakın.

Sub Bul_Renklendir()
  Dim neyi As String, rng As Range, alan As Range
  icerir = False
  neyi = Application.InputBox("A1:D20 hücrelerinde, bulmak istediğiniz veri", , "")
  If MsgBox("Arama içerir mi olsun?", vbYesNo) = vbYes Then
     icerir = True
  End If

  Set alan = Range("A1:D20")
  alan.Interior.ColorIndex = xlNone
  For Each rng In alan
      If StrConv(rng, vbLowerCase) Like "*" & StrConv(neyi, vbLowerCase) & "*" And icerir = True Then
          rng.Interior.ColorIndex = 35
      End If
      If StrConv(rng, vbLowerCase) = StrConv(neyi, vbLowerCase) And icerir = False Then
          rng.Interior.ColorIndex = 35
      End If
     
  Next rng
  Set alan = Nothing
End Sub

Bu kodu örnekte de olduğu gibi A sütununda bulunan bir ismi E ile J aralığında herhangi bir yerde varsa büyük küçük harfe duyarlı olmayacak şekilde ve yapabilirse trim yaparak(Hatalı boşluk koyulmuşsa birebir eşleşmeyebilir) toplu aratabilir miyiz ?