Bul ve Git

[altanson]

Arkadaşlar çok basit bir makro olduğunu biliyorum ama diğer örneklerdeki makroları kendi dosyama uygulayamadım.

Yapmak istediğim şu;

Belli bir sütunda (örneğin B) belirli bir metni (Örneğin AAA) içeren ilk hücreyi bulup o hücreye gidecek bir makro yazmak istiyorum.

Teşekkürler.

 

[Recep İpek]

Aşağıdaki kodları deneyiniz.

Sub BulveGit()
Range("b2:b1000").Find(What:="AAA", LookAt:=xlWhole, MatchCase:=False).Activate
End Sub

 

[Korhan Ayhan]

Selamlar,

Recep bey cevaplamış ama alternatif olması açısından aşağıdaki koduda kullanabilirsiniz.

Sub BUL_GİT()
    ARANAN = Application.InputBox("LÜTFEN ARAMAK İSTEDİĞİNİZ DEĞERİ GİRİNİZ !", "ARAMA")
    If ARANAN = "" Or ARANAN = False Then Exit Sub
    Set BUL = [B:B].Find(ARANAN)
    If Not BUL Is Nothing Then
    Range(BUL.Address).Select
    Else
    MsgBox "ARANAN DEĞER BULUNAMAMIŞTIR !", vbCritical, "DİKKAT !"
    End If
    Set BUL = Nothing
End Sub

 

[altanson]

arkadaşlar çok teşekkürler, elinize sağlık.

 

[numanexcel]

Arkadaslar,

Bu soru ile alakali olabilecegini dusundugum bir problemim var.
Yukaridaki ornekte belli bir metin aranmaktadir. Ancak ben Bir formul ile hesaplanmis degeri aratmak istiyorum.
Ornek olarak B sutununda icinde formul yazili hucreler olsun. Bu formullerin bazilari icin sonuc bulunamasin ve deger olarak "#N/A" yazsin hucrelerde. Benim istedigim ise B Sutunu icerisinde Hucre degeri (Formul sonucu hesaplanmis deger) "#N/A" olan hucreleri bulmak. Bu hucrelerin ilkini bularak devaminda onun yerine bir deger kopyalatip yapistiracagim. Daha sonra da Next diyerek bunu diger hucreler icin tekrarlatacagim. Dedigim gibi benim istedigim Elle girilmis degeri degil de Formulle hesaplanmis deger tarif edip buldurabilmek.

Umarim yeteri kadar aciklayabilmisimdir.

Tesekkurler...

 

[Recep İpek]

Sayfa üzerinde Ctrl+G yaparak sol atta Special seçilir.

Bu ekranda ise Formulas seçilip Errors işaretlenir.

Bu şekilde tüm hata veren formüller seçilmiş olur.

 

[karagöz55]

Sub BUL_GİT()
ARANAN = Application.InputBox("LÜTFEN ARAMAK İSTEDİĞİNİZ DEĞERİ GİRİNİZ !", "ARAMA")
If ARANAN = "" Or ARANAN = False Then Exit Sub
Set BUL = [B:B].Find(ARANAN)
If Not BUL Is Nothing Then
Range(BUL.Address).Select
Else
MsgBox "ARANAN DEĞER BULUNAMAMIŞTIR !", vbCritical, "DİKKAT !"
End If
Set BUL = Nothing
End Sub

YUKARIDAKİ FORMUL GERÇEKTEN ÇOK GÜZEL
Ancak bulunan hücrenin renginin de değişik bir şekilde gözükmesi için mesela sarı olacak şekilde ayarlamak için bu koda nasıl bir ekleme yapılması gerekir.
İlgilinecek arkadaşlara şimdiden teşekkürler

 

[Orion1]

Aşağıdaki gibi denermisiniz.

Sub BUL_GİT()
[COLOR="Red"][B]Range("B:B").Interior.ColorIndex = xlNone[/B][/COLOR] 
ARANAN = Application.InputBox("LÜTFEN ARAMAK İSTEDİĞİNİZ DEĞERİ GİRİNİZ !", "ARAMA")
If ARANAN = "" Or ARANAN = False Then Exit Sub
Set BUL = [B:B].Find(ARANAN)
If Not BUL Is Nothing Then
Range(BUL.Address).Select
[COLOR="red"][B]Selection.Interior.Color = vbYellow[/B][/COLOR]
Else
MsgBox "ARANAN DEĞER BULUNAMAMIŞTIR !", vbCritical, "DİKKAT !"
End If
Set BUL = Nothing
End Sub

 

[altanson]

arkadaşlar açtığım konu ile ilgili bir şey daha sormak istiyorum,

aradığım ve makro ile gittiğim hücreyi veya hücre aralığını farklı bir renk ile işaretleyebilir miyim?

örneğin;

Sub BulveGit()
Range("b2:b1000").Find(What:="AAA", LookAt:=xlWhole, MatchCase:=False).Activate
End Sub

makrosu ile gittiğim hücre B12 ise B12:J19 aralığını farklı bir renk ile nasıl gösteriririz?

 

[Orion1]

Buyurun kodlarınız.

Sub BulveGitverenklendir()
Dim k  As Range
Set k = Range("b2:b1000").Find(What:="AAA", LookAt:=xlWhole, MatchCase:=False)
If Not k Is Nothing Then
    k.Select
    Range(Cells(k.Row, "B"), Cells(k.Row, "J")).Interior.Color = vbRed
    Range(Cells(k.Row, "B"), Cells(k.Row, "J")).Font.Color = vbYellow
End If
Set k = Nothing
End Sub

 

[altanson]

Evren Bey çok teşekkürler, son bir şey sorabilir miyim?

Bu makroyu tek bir satır değilde altındaki 6 satıra nasıl uygulayabiliriz? Bir de herhangi bir hücre seçildiğinde renklendirme otomatik kalkarsa çok güzel olur )

 

[Orion1]

Evren Bey çok teşekkürler, son bir şey sorabilir miyim?

Bu makroyu tek bir satır değilde altındaki 6 satıra nasıl uygulayabiliriz? Bir de herhangi bir hücre seçildiğinde renklendirme otomatik kalkarsa çok güzel olur )

6 satır aşağısınıda renklendirmek için aşağıdaki kodu.

Sub BulveGitverenklendir()
Dim k  As Range
Set k = Range("b2:b1000").Find(What:="AAA", LookAt:=xlWhole, MatchCase:=False)
If Not k Is Nothing Then
    k.Select
    Range(Cells(k.Row, "B"), Cells(k.Row+6, "J")).Interior.Color = vbRed
    Range(Cells(k.Row, "B"), Cells(k.Row+6, "J")).Font.Color = vbYellow
End If
Set k = Nothing
End Sub

Seçilen bir hücre olduğu zaman tüm hücrelerin renksiz olması için aşağıdaki kodları syafanın kod sayfasında selection_change olayına yazınız.

cells.Interior.Colorindex= xlnone
    cells.Font.Colorindex = 0

 

[altanson]

Seçilen bir hücre olduğu zaman tüm hücrelerin renksiz olması için aşağıdaki kodları syafanın kod sayfasında selection_change olayına yazınız.

cells.Interior.Colorindex= xlnone
    cells.Font.Colorindex = 0

Evren Bey,

Sadece Bir önceki kod ile renklendirdiğimiz hücreleri eski rengine döndürebilir miyiz? sayfada renklendirilmiş başka hücrelerde var.

 

[Orion1]

O zaman şöyle yapalım.Boş bir standart modüle açın ve aşağıdaki tanımlama satırını girin.

Public adr as string

İlgili kodları aşağıdaki ile değiştirin.

Sub BulveGitverenklendir()
Dim k  As Range
Set k = Range("b2:b1000").Find(What:="AAA", LookAt:=xlWhole, MatchCase:=False)
If Not k Is Nothing Then
    k.Select
    adr=Range(Cells(k.Row, "B"), Cells(k.Row+6, "J")).address
    Range(adr).Interior.Color = vbRed
    Range(adr).Font.Color = vbYellow
End If
Set k = Nothing
End Sub

çalışma sayfasının kod bölümüne selection_change olayına aşağıdaki kodu girin.

if adr="" then exit sub
range(adr).Interior.Colorindex=xlnone
range(adr).font.colorindex=0
adr=""

çalışma kitabının thisworbook_before_close olayınada aşağıdaki kodu giriniz.

if adr="" then exit sub
sheets("Sayfa1").range(adr).Interior.Colorindex=xlnone
sheets("Sayfa1").range(adr).font.colorindex=0
adr=""

 

[altanson]

Evren Bey,

Renklendirmeyi yaptım fakat makro çalıştıktan sonra seçilen ilk hücrede bu renklendirmenin kaldırılmasını beceremedim

 

[Orion1]

Evren Bey,

Renklendirmeyi yaptım fakat makro çalıştıktan sonra seçilen ilk hücrede bu renklendirmenin kaldırılmasını beceremedim

Buyurun dosyanız.

 

[altanson]

Evren bey harika olmuş elinize sağlık zahmet verdim

 

[Orion1]

Evren bey harika olmuş elinize sağlık zahmet verdim

Rica ederim.
İyi çalışmalar.