Eşleştirme koşullu biçimlendirme

[metince54]

merhaba elimde bir liste var. 14 personel var. Malum virüs dolasıyla hergün personellerin temas listesini çıkartıyorum. a personeli d personeline temas ettim diyor ama d personeli a personelini temas listesine almıyor buda sistemin sağlıklı çalıştırmıyor. benim sistem ricam örnek resim attım excelide atayım . harfler temsilidir isimlerle sonradan değiştirir yada harf ile bağlantı kurabilirim. bunun için vba mı olur koşullu biçimlendirmemi bilemedi açıkcası. şimdiden teşekkür ederim.

 

[YUSUF44]

Aşağıdaki kodları ilgili sayfanın kod bölümüne (sayfa adına sağ tıklayıp kod görüntüle deyince açılan sayfaya) yapıştırıp deneyiniz. Hücrelere tıkladıkça boyama işlemini yapar:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [A2:N14]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
If WorksheetFunction.CountIf([A1:N1], Target) = 0 Then
    MsgBox Cells(1, Target.Column) & " adlı personelin temas ettiği " & Target & " adlı personel tabloda bulunmamaktadır", vbInformation
    Exit Sub
Else
    sut = WorksheetFunction.Match(Target, [A1:N1], 0)
    If WorksheetFunction.CountIf(Range(Cells(1, sut), Cells(14, sut)), Cells(1, Target.Column)) > 0 Then
        sat = WorksheetFunction.Match(Cells(1, Target.Column), Range(Cells(1, sut), Cells(14, sut)), 0)
        Cells(sat, sut).Interior.ThemeColor = xlThemeColorAccent1
    End If
    Target.Interior.ThemeColor = xlThemeColorAccent1
End If
End Sub

 

[metince54]

Çok sağolun akşama kontrol edeceğim. harfler yerine personellerin adını yazdığımızda sorun olmaz sanırım. buna şöyle bir takviye yapabilir miyiz? a kişi için tıkladığım kişileri a kişi b d e f sonra b için a g gibi listeye hazırlayabilir miyiz.

 

[YUSUF44]

Kod hücredeki değere göre işlem yapar, isim, kod, sicil, sayı fark etmez.

ilave etmek istediğiniz konuyu daha açık anlatır mısınız? Mmkünse örnek dosyada nasıl bir sonuç istediğinizi gösterin.

 

[YUSUF44]

İkinci isteğiniz şöyle bir şey galiba, aşağıdaki kodları deneyiniz. Kodlar otomatik çalışmaz, ayrıca çalıştırmanız gerekir (düğmeyle vs):

Sub listele()
[S2:AF14].ClearContents
[A1:N1].Copy [S1]

For kaynak = 1 To 14
    For hedef = 2 To 14
        If Cells(hedef, kaynak).Interior.ThemeColor = xlThemeColorAccent1 Then
            yeni = Cells(Rows.Count, kaynak + 18).End(3).Row + 1
            Cells(yeni, kaynak + 18) = Cells(hedef, kaynak)
        End If
    Next
Next

End Sub

Kod çalıştığında S sütunundan itibaren istediğinize benzer bir tablo oluşturur. Farklı bir çözüm istiyorsanız örnek dosya ile gösteriniz lütfen.

 

[metince54]

Çok teşekkür ederim öncelikle kıymetli zamanınızı ve bilgi birikiminizi benimle paylaştığınız için. Kod çalışıyor detaylı kullanım sonrası ins tekrar bilgi vereceğim. iyi günler dilerim.