Düşeyara ile gelen değerlerin biçimleri ile gelmesi

[civerb]

Merhaba, düşeyara komutunu kullanıyorum.. Listenin sıra numaraları var ve yanında isimler, düşeyara ile numaraya denk gelen ismi çağırıyorum.. Fakat listedeki isimlerin biçimleri de gelsin istiyorum.. Yazıtipi rengi ve/veya hücre rengi.. Nasıl yapılabilir? (Öncelikle makrosuz olabilmesi tercihimdir, olmazsa o da kabul.. Teşekkürler..

 

[1Al2Ver]

Merhaba, düşeyara komutunu kullanıyorum.. Listenin sıra numaraları var ve yanında isimler, düşeyara ile numaraya denk gelen ismi çağırıyorum.. Fakat listedeki isimlerin biçimleri de gelsin istiyorum.. Yazıtipi rengi ve/veya hücre rengi.. Nasıl yapılabilir? (Öncelikle makrosuz olabilmesi tercihimdir, olmazsa o da kabul.. Teşekkürler..

Merhaba,

Sanırım makro gerekli,

Öneri ;

Doğru ve çabuk cevap almak için, 2003 formatında, şifre içermeyen örnek bir dosya ekleyiniz ve örnekleyiniz,

Teşekkür ederim.

 

[civerb]

Taslak bi dosya ve ekran görüntüsü ile derdimi anlatmaya çalıştım, yardımcı olabileceklere şimdiden teşekkürler..

 

[N.Ziya Hiçdurmaz]

yanıt

Sub bul()
Dim sat As Integer
Dim alan As Range
For Each alan In Range("a1:ı20")
For sat = 3 To Cells(65536, "k").End(xlUp).Row
    If alan Like Cells(sat, "k") Then
        Cells(sat, "l").Copy alan.Offset(0, 1)
    End If
Next
Next
End Sub

 

[civerb]

Çok teşekkürler, işimi gördü.. Ben makrolardan pek anlamam ama kolay bi çözümmüş, kullanırım bunu..

Sadece sayıları değiştirince düşeyara komutunun bulduğu değer güncellenmiyor makroyu ekleyince, eski değer kalıyor, dolayısıyla renkler otomatik değişmiyor, arada bir manuel olarak makroyu çalıştırmam gerekiyor, o da çok sorun diil, yaparım elle.. teşekkürler..

 

[N.Ziya Hiçdurmaz]

yanıt

Sayfa kod bölümüne uygulayarakta kullanabilirsiniz.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [a1:l20]) Is Nothing Then Exit Sub
Dim sat As Integer
Dim alan As Range
For Each alan In Range("a1:ı20")
For sat = 3 To Cells(65536, "k").End(xlUp).Row
    If alan Like Cells(sat, "k") Then
        Cells(sat, "l").Copy alan.Offset(0, 1)
    End If
Next
Next
End Sub