Bir hücreyi seçince benim belirlediğim bir hüceyi boyasın

[sefikap]

Herkese selam,
Aşağıdaki kodu yazdım...ama olmadı..sayfa içerisinde nereye tıklarsam tıklayayım "C5" hücresine gidiyor.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("C5").Select Then
Range("A4:B4").Interior.ColorIndex = 15
End If
End Sub

Ben sayfada herhangi bir hücreyi (benim belirlediğim) seçtiğimde, yine benim belirlediğim başka bir hücreyi boyamak istiyorum(Renk önemli değil), Başka bir hücre seçtiğimde ise yine benim belirleyeceğim başka bir hücreyi boyasın istiyorum..

Yani seçilecek hücre ve değişecek hücreleri ben belirlemek istiyorum.

Yardımcı olabilirmisiniz ?
Kesin çok basit bir çözümü var biliyorum ama bulamadım.

Saygılarımla
Şefika POLAT

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
    If Intersect(Target, Range("C5")) Is Nothing Then Exit Sub
 
    Range("A4:B4").Interior.ColorIndex = 15
 
End Sub

.

 

[sefikap]

çok teşekkür ederim,
konuyu biraz açmama müsaade ederseniz sorunumu aşağıda anlatmaya çalıştım..
Elimdeki dosyada 308 satırdan oluşan bir süreç takip dosyası var, ve her satırda , o satırdaki süreci yapabilmek için bitirmek zorunda olduğumuz bir ön koşul numarası var (Umarım uzun ve karmaşık bir cümle olmamıştır.)
Üzerinde çalıştığım dosyanın benzeri bir dosyayı ekte bulabilirsiniz.

Ekteki dosyadan örnek verecek olursam, "Seri Üretim Fazı'nı" yapmaya başlayabilmek için "Ürün Gerçekleştirme Fazı'nı" bitirmiş olma Ön koşulu var

Benim sormak istediğim şu;

Ben bu ön koşul numaralarının yazılı olduğu hücreleri seçtiğimde,ön koşul olarak yapılması gereken işin bulunduğu hücrenin renginin değişmesini ve kalın kenarlıklı olmasını istiyorum,bir alt satıra geçtiğimde o hücredeki ön koşula ait yapılacak iş hücresinin değişmesini...vs istiyorum..ancak seçimden çıktığımızda da hücre eski haline dönebilmeli..

Yani kısaca Kullanıcı , ön koşul numaralarının olduğu hücrelerde gezinirken, Hangi işleri yapacağı gözüne çarpsın, bu iş hücreyi boyayarak yada ne bileyim çerçevesini kalınlaştırarak olabilir.

Başka bir fikriniz varsa o da olabilir, önerilere açığım.

Yardımlarınız için şimdiden teşekkür ederim

Saygılarımla

 

[Ömer]

Çalıştığınız sayfanın kod bölümüne kopyalayın.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
    Dim deg As Variant, i As Integer, c As Range
 
    If Intersect(Target, Range("C2:C65500")) Is Nothing Then Exit Sub
 
    [B:B].Interior.ColorIndex = 0
    [COLOR=blue][C2:C65500].Replace " ", "", LookAt:=xlPart[/COLOR]
 
    On Error Resume Next
 
    deg = Split(Target, "[COLOR=red][B],[/B][/COLOR]")
    For i = 0 To UBound(deg)
        Set c = [A:A].Find(deg(i), , xlValues, xlWhole)
        If Not c Is Nothing Then
            Cells(c.Row, "B").Interior.ColorIndex = 15
        End If
    Next i
 
End Sub

.

 

[sefikap]

Tek kelime ile harikasınız..

Mükemmel, aklınıza sağlık...

 

[sefikap]

Son birşey daha..
Kodu biraz açıklamanız mümkün mü?

Mantığını da anlamak adına yani..)

Saygılarımla
Şefika POLAT

 

[Ömer]

Çok fazla detaya inecek zamanım olmadığı için kısaca bölüm olarak açıklamaya çalıştım.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
    [COLOR=teal]' Kullandığımız değişkenleri tanımladık'''''''''''''''''''''''''''[/COLOR]
    Dim deg As Variant, i As Integer, c As Range
    [COLOR=teal]''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' [/COLOR]
 
    [COLOR=teal]'''''' Sadece C2:C65500 hücreleri arası çalışması için eklenen şart''''[/COLOR]
    If Intersect(Target, Range("C2:C65500")) Is Nothing Then Exit Sub
    [COLOR=teal]'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''[/COLOR]
 
    [COLOR=teal]'''''' B sütunundaki hücleri renksiz yapar. Nedeni; Veri değişiminden-[/COLOR]
    [COLOR=teal]'renklenen hücreleri renksiz yapıp yeni şarta uygun hale getirmek''''''[/COLOR]
    [B:B].Interior.ColorIndex = 0
    [COLOR=teal]'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''[/COLOR]
 
    [COLOR=teal]'''''' C sütununa girdiğiniz bazı verlerde boşluk varbazılarında ise yok-[/COLOR]
[COLOR=teal]  ' Bunun için C sütununa girilen boşluk karakterleri sildik '''''''''''''[/COLOR]
    [C2:C65500].Replace " ", "", LookAt:=xlPart
[COLOR=teal]  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''[/COLOR]
 
   [COLOR=teal]'''''' Hata varsa atla dedik.. Bazı hücrelerde tek rakam bazı hücrelerde,[/COLOR]
[COLOR=teal]  'ise [COLOR=red][B]virgül[/B][/COLOR] ile birden fazla rakam girdiniz. Bunu ayırmak için "split" kodu[/COLOR]
[COLOR=teal]  'kullandıktan. Eğer virgül olmayan hücre varsa kod hata vermesin diye,[/COLOR]
[COLOR=teal]  'hataları bu şekilde atlarız. ''''''''''''''''''''''''''''''''''''''''''''[/COLOR]
    On Error Resume Next
[COLOR=teal]  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''[/COLOR]
 
[COLOR=teal]  ' Bu bölümde önce hücreye girilen değer birden fazla numara ise, bu değeri[/COLOR]
[COLOR=teal]  'split kodu ile ayırıp ayrı ayrı ubond ile diziye sokup her değeri tek tek,[/COLOR]
[COLOR=teal]  'okuruz.. Örneğin 7[B][COLOR=red],[/COLOR][/B]8[COLOR=red][B],[/B][/COLOR]9 şeklinde veri girerseniz bu veriyi dizi ile 7 8 9[/COLOR]
[COLOR=teal]  'rakamlarını ayrı ayrı okuruz ve find komutu ile A sütununda ararız,[/COLOR]
[COLOR=teal]  'bulduklarımızı renklendiririz.''''''''''''''''''''''''''''''''''''''''''''[/COLOR]
    deg = Split(Target, "[COLOR=red][B],[/B][/COLOR]")
    For i = 0 To UBound(deg)
        Set c = [A:A].Find(deg(i), , xlValues, xlWhole)
        If Not c Is Nothing Then
            Cells(c.Row, "B").Interior.ColorIndex = 15
        End If
    Next i
 [COLOR=teal]   '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''[/COLOR]
 
End Sub

.

 

[sefikap]

bütün gün bir çok soru sordum ama tamamen benim hatam..yanlış anlatmışım.

Orjinal dosya ekte..

Öyle bir kod olmalı ki..
"C" sütununda bir hücrenin üzerine geldiğimde, hücrenin içindeki değeri veya değerleri "A" sütununda bulsun ve yanındaki açıklama hücresi ile beraber boyasın istiyorum olacaktı..

bundan önce cevap yazan tüm arkadaşlardan da çok ama çok özür dilerim..

Saygılarımla
Şefika POLAT

 

[Ömer]

#4 numaralı mesajda mavi işaretlediğim satırı silip, kırmızı işaretlediğim virgül yerine ise / ayıraçını yazın.

Yalnız C sütununa girilen veri ile A sütununda olan veri aynı olmalırı. C sütunundaki verilerde boşluk kullanmamışsınız fakat A sütunundaki veriler arasında boşluk var. Aynı düzende giriş yapmazsanız kod aranan değeri bulamaz ve istediğiniz olmaz.