biçime göre değer

[pylor]

sayın excel veb uzmanları merak ettiğim bir şey var şimdi biz hücredeki bir değere göre aynı hücreyi veya değişik hücreyi yada sütunu biçimlendirebiliyoruz adınada koşullu biçimlendime diyoruz peki değere göre biçim değilde biçime göre değer atama şansımız varmı yani A1 hücresinin yazı fontu rengi sarı olursa B1 hüresine istenen değerin yazılması gibi yada A1 hücresinin dolgu rengi kırmızı ise A1 hücresine girilen değerin rengini sarı yapsın gibi.ben calışmamda yazı rengine ve hücre dolgu rengine göre diğer hücrelere değer atamak istiyorum bu mümkünmüdür

 

[N.Ziya Hiçdurmaz]

yanıt

Kod ile isterseniz, örneği sayfa kod bölümüne uygulayıp deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Cells(Target.Row, "a").Interior.ColorIndex = 6 Then Cells(Target.Row, "b") = "deneme"
If Cells(Target.Row, "a").Interior.ColorIndex = 3 Then Cells(Target.Row, "a").Font.ColorIndex = 6
End Sub

 

[pylor]

sayın hiçdurmaz bu işlemi koşullu biçimlendirme ile yapmak istesek nasıl bir yol izlemeliyiz acaba

 

[Korhan Ayhan]

Selamlar,

Koşullu biçimlendirme özelliğinde hücrenin biçimine göre biçimlendirme özelliği yoktur.

 

[pylor]

sayın hiçdurmaz ve sayın ayhan cevaplarınız için teşekkür ederim kodlarınızı kendi çalışmama uyarladım ancak sayfanın kod bölümünde daha başka bir çok çalışan kod olduğu için o kodlara entegre edemedim sizden ricam kendime uyarladığım bu kodları sayfadaki diğer kodlara entegre etmenizdir benim için bunu yaparsanız çok memnun olurum teşekkür edrim
kodlar

Private Sub Worksheet_Change(ByVal Target As Range)
If Cells(Target.Row, "ı") = "A" Then Cells(Target.Row, "d").Font.ColorIndex = 6
If Cells(Target.Row, "ı") = "A" Then Cells(Target.Row, "d").Interior.ColorIndex = 3
If Cells(Target.Row, "ı") = "P" Then Cells(Target.Row, "d").Font.ColorIndex = 3
End Sub

 

[pylor]

dosyayı eklemeyi unutmuşum şimdi ekledim kolay gelsin

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz. Sadece mavi renkli kod bloğunu aşağıdaki kod ile değiştirin.

Private Sub [COLOR=blue]Worksheet_Change[/COLOR](ByVal Target As Range)
 
Dim deg As String, adres As String, formul As String
Dim formul_adres_1 As String, formul_adres_2 As String
Dim Sd As Worksheet, sut As Byte
 
If Intersect(Target, Range("C:C,E:E,F:F,I:I,K:K,M:M")) Is Nothing Then Exit Sub
If Selection.Cells.Count > 1 Then Exit Sub
 
[COLOR=red]If Cells(Target.Row, "ı") = "A" Then Cells(Target.Row, "d").Font.ColorIndex = 6
If Cells(Target.Row, "ı") = "A" Then Cells(Target.Row, "d").Interior.ColorIndex = 3
If Cells(Target.Row, "ı") = "P" Then Cells(Target.Row, "d").Font.ColorIndex = 3
[/COLOR] 
Set Sd = Sheets("DATA")
sut = WorksheetFunction.Choose(Target.Column, _
                   1, 1, 4, 1, 2, 1, 1, 1, 3, 1, 5, 1, 6)
 
If Target.Column = 6 Then
 
On Error Resume Next
deg = UCase(Replace(Replace(Target.Value, "ı", "I"), "i", "İ"))
adres = "f" & Target.Row & ":g" & Target.Row
Range(adres).Interior.ColorIndex = xlNone
Target.Interior.ColorIndex = xlNone
Target.Offset(0, 1).ClearContents
formul_adres_1 = "c2:c" & Target.Row
formul_adres_2 = "f2:f" & Target.Row
formul = "=SUMPRODUCT((YEAR(" & formul_adres_1 & ")=YEAR(" & "c" & Target.Row & "))*(" & formul_adres_2 & "=" & Target.Address & "))"
 
Sd.Cells(Target.Row, sut) = Target.Value
 
If deg = "1" Then
Range(adres).Interior.ColorIndex = 4
Target.Offset(0, 1) = Evaluate(formul)
ElseIf deg = "2" Then
Range(adres).Interior.ColorIndex = 5
Target.Offset(0, 1) = Evaluate(formul)
ElseIf deg = "3" Then
Range(adres).Interior.ColorIndex = 6
Target.Offset(0, 1) = Evaluate(formul)
ElseIf deg = "4" Then
Range(adres).Interior.ColorIndex = 46
Target.Offset(0, 1) = Evaluate(formul)
ElseIf deg = "5" Then
Range(adres).Interior.ColorIndex = 8
Target.Offset(0, 1) = Evaluate(formul)
ElseIf deg = "G" Then
Range(adres).Interior.ColorIndex = 7
Target.Offset(0, 1) = Evaluate(formul)
End If
Else
Sd.Cells(Target.Row, sut) = Target.Value
End If
End Sub

 

[pylor]

sayın ayhan önerdiğiniz kod işimi gördü teşekkür ederim