koşula göre hücre eşitleme

[pylor]

sayın excel web uzmanları öncelikle kolay gelsin demek istiyorum benim bir sorum olacak mesela O1 hücresinin rengi yeşil ise M1 hücresini yeşil yapıp K1 hücresindeki tarihi M1 hücresine yazdırabilirmiyiz cevabınız için şimdiden teşekkürler tekrar kolay gelsin.
NOT: sayfamın kod bölümünde çalışan başka kodlarda var çalışan kodlarım ise şöyledir.

KOD.
Private Sub Worksheet_Change(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 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



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

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 = "Z" Then
Range(adres).Interior.ColorIndex = 3
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 = 15
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
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
If Intersect(Target, Range("j2:j" & [j65536].End(3).Row)) Is Nothing Then GoTo 10
a = Application.WorksheetFunction.Match(Target.Value, Sheets("ICD_10").Range("a:a"), 0)
Application.GoTo ActiveWorkbook.Sheets("ICD_10").Cells(a, "a")
10:
If Intersect(Target, Range("Q:Q")) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
Cancel = True
Set ds = CreateObject("Scripting.FileSystemObject")
yol = "d:\d-belgeler\epikriz"
Do
If ds.GetFolder(yol).subfolders.Count > 0 Then
For Each kls In ds.GetFolder(yol).subfolders
klslst = klslst & "{" & kls
Next
End If
X = X + 1
deg = Split(klslst, "{")
yol = deg(X)

dosya = Dir$(yol & "\" & Target & ".*")
Do While dosya <> ""
CreateObject("Shell.Application").Open yol & "\" & dosya
Exit Sub

dosya = Dir$()
Loop

Loop While UBound(deg) <> X
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("j2:j" & [j65536].End(3).Row)) Is Nothing Then Exit Sub
Dim s1 As Worksheet
Set s1 = Sheets("ICD_10")
On Error GoTo son
sat = Application.WorksheetFunction.Match(Target.Value, s1.Range("a:a"), 0)
alt = sat + 1
Target.ClearComments
For i = sat To alt
If s1.Cells(i + 1, "a") <> "" Then
yrm = yrm & " " & s1.Cells(i, "b") & " " & s1.Cells(i, "c")
Exit For
Else
If s1.Cells(i, "b") = "" Then Exit For
yrm = yrm & " " & s1.Cells(i, "b") & " " & s1.Cells(i, "c")
alt = alt + 1
End If
Next i

Target.AddComment Text:=yrm
Target.Comment.Shape.TextFrame.AutoSize = True
son:
Set s1 = Nothing
End Sub

 

[Levent Menteşoğlu]

O1 hücresini nasıl yeşil yapıyorsnuz. Yani kod ilemi yoksa menülerden kendinizmi?

 

[pylor]

sayın menteşoğlu O1 hücresini manuel olarak yeşil yapıyorum manuel olarak yeşil yaptığımda yukarıda anlattığım bu olayın gerçekleşmesini istiyorum teşekkür ederim

 

[Levent Menteşoğlu]

sayın menteşoğlu O1 hücresini manuel olarak yeşil yapıyorum manuel olarak yeşil yaptığımda yukarıda anlattığım bu olayın gerçekleşmesini istiyorum teşekkür ederim

Bu işlemi el ile yapıyorsanız bunu algılayacak bir olay (event) olmadığı için ancak ikinci bir işlem olarak kontrol kodunu çalıştırmanız gerekir.

 

[pylor]

sayın menteşoğlu bu sorunum için önerebileceğiniz bir çözüm varmı mesela bir buton yardımı ile yada sayfadaki başka bir olayın ardından çalışan bir makro ilede olabilir yada "eğer" fonksiyonun yardımı ile olması mümkünmü acaba veya sizin önerebileceğiniz başka bir çözüm varsa çok memnun olurum teşekkürler