• DİKKAT

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

Bul makrosunu geliştirme

Katılım
1 Mayıs 2011
Mesajlar
21
Excel Vers. ve Dili
Exel 2010 TR
Merhaba,

Ekteki bul makrosunu geliştirmek istiyorum.
Makroda Bul tıklanım "a" yazdığımızda. İlk a harfinin içerdiği kutuyu bulup kısa bir süre renkli olarak gösteriyor.
Geliştirmek istediğim;
1- Aramayı sadece A sütünunda yapsın. Sayfanın geri kalanında aramasın.
2- Aramayı bulduktan sonra bulduğu kodu kısa bir süre renkli gösteriyor. Ben bulduğu kodu ve yanında ki B,C,D,E kutularınıda kısa süreli renkli göstersin istiyorum.
3- Arada boşluk olsun veya olmasın kodu bulabilsin. Örnek: Bul'u tıkladıktan sonra. aa 22 yazarsam hem aa22 hem de aa 22 olarak arasın.
4- Eğer herhangi bir ürün bulunamazsa bu kod bulunamadı gibi bir mesaj cıkarsın.

Bunları ekteki makroya eklemek mümkün müdür?

Not: Ekteki makroyu konuların arasında buldum. Yazan üstada teşekkürler. Yerini tekrar bulamadım. Burdan yazıyorum.
 

Ekli dosyalar

Selamlar,

Forumumuza hoşgeldiniz. Aşağıdaki kodu denermisiniz.

Kod:
Option Explicit
 
Sub BUL_RENKLENDİR()
    Dim Aranacak_Veri As Variant, Bul As Range
 
    Aranacak_Veri = Application.InputBox("Aramak istediğiniz kelimeyi yazınız.", Application.UserName)
    If Aranacak_Veri = False Or Aranacak_Veri = "" Then Exit Sub
 
    Set Bul = Range("A:A").Find(Aranacak_Veri)
    If Not Bul Is Nothing Then
        Bul.Select
        ActiveCell.Resize(1, 5).Interior.ColorIndex = 4
        Application.Wait Now + TimeValue("00:00:02")
        ActiveCell.Resize(1, 5).Interior.ColorIndex = xlNone
    Else
        Set Bul = Range("A:A").Find(Replace(Aranacak_Veri, " ", ""))
        If Not Bul Is Nothing Then
            Bul.Select
            ActiveCell.Resize(1, 5).Interior.ColorIndex = 4
            Application.Wait Now + TimeValue("00:00:02")
            ActiveCell.Resize(1, 5).Interior.ColorIndex = xlNone
        Else
            MsgBox "Aradığınız veri bulunamadı !", vbCritical
        End If
    End If
 
    Set Bul = Nothing
End Sub
 
Korhan Bey, çok teşekkür ederim. Mükemmel çalışıyor. Elinize sağlık.
 
Geri
Üst