Hücre değerine göre başha hücreye yazma

[akviran42]

Değerli Üstatlarım ;

Bir sorum olacaktı yardımcı olursanız sevinirim.
M5 hücresine 2,34,5.....13 değerinden biri varsa M5 teki değere göre E8,F8,G8 HÜCRELERİNE "OK" yazmasını istiyorum. Mesela M5 hücresinde 5 varsa E8,F8,G8 H8 VE I8 hücrelerine "OK" yazsın

Selametle kalın

 

[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 dediğinizde açılans ayfaya) yapıştırıp deneyiniz. Kod M5 hücresine 2-13 arası tamsayı girildiğinde E8:I8 arasına OK yazar, başka bir şey yazılırsa o hücreleri boşaltır:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [M5]) Is Nothing Then Exit Sub
If Target = 2 Or Target = 3 Or Target = 4 Or Target = 5 Or Target = 6 _
            Or Target = 7 Or Target = 8 Or Target = 9 Or Target = 10 _
            Or Target = 11 Or Target = 12 Or Target = 13 Then
    [E8:I8] = "OK"
Else
    [E8:I8] = ""
End If
End Sub

 

[akviran42]

Yusuf bey ;
Teşekkür ederim istediğim gibi ama M5 hücresine ne yazarsan yazıyım 5 adet ok yazıyor [E8:I8] = "OK" [E8:Q8] = "OK" yaptığım zaman hepsine yazıyor Sizden istediğim m5 hücresinde kaç yazarsa o kadar hücreye "OK" yazması birde m5 hücresinde eğer formülü olduğu zaman çalışmıyor onuda yapabilirmisiniz
Sizi uğraştıracağım için kusura bakmayın

 

[YUSUF44]

Önceki mesajınızı tam anlamadığımdan öyle hazırlamıştım. Aşağıdaki kodu deneyiniz:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [M5]) Is Nothing Then Exit Sub
If Target = 1 Or Target = 2 Or Target = 3 Or Target = 4 Or Target = 5 Or Target = 6 _
            Or Target = 7 Or Target = 8 Or Target = 9 Or Target = 10 _
            Or Target = 11 Or Target = 12 Or Target = 13 Then
    [E8:Q8] = ""
    Range(Cells(8, "E"), Cells(8, Target.Value + 4)) = "OK"
Else
    [E8:Q8] = ""
End If
End Sub

 

[YUSUF44]

EĞER formülüyle ilgili de eğer formülün ne olduğunu belirtirseniz o formüldeki şartlara göre kodu tekrar düzenlerim.

 

[akviran42]

Yusuf Bey ;
M6 hücresindeki formül açıklaması aşağıdaki gibi

EĞER(M6>35001;"13";EĞER(M6>1201;"8";EĞER(M6<25;"2";EĞER(M6<150;"3";EĞER(M6<1200;"5";EĞER)))))

Açıklama ;
m6 2 den büyük 25 den küçükse 2 yaz
m6 26 den büyük 150 den küçükse 3 yaz
m6 151 den büyük 1200 den küçükse 5 yaz
m6 1201 den büyük 35000 den küçükse 8 yaz
m6 35001 den büyük 500000 den küçükse 13 yaz

şeklinde yazmıştım

Saygılarımla

 

[YUSUF44]

Aşağıdaki kodu deneyiniz. M6 hücresine girilen sayıya göre istediğiniz değişikliği yapar:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [M6]) Is Nothing Then Exit Sub

If Target <> "" Then
    If Target >= 35001 Then
        numune = 13
    ElseIf Target >= 1201 Then
        numune = 8
    ElseIf Target >= 151 Then
        numune = 5
    ElseIf Target >= 26 Then
        numune = 3
    ElseIf Target >= 2 Then
        numune = 2
    Else
        numune = 0
    End If
    [E8:Q8] = ""
    Range(Cells(8, "E"), Cells(8, numune + 4)) = "OK"
Else
    [E8:Q8] = ""
End If
End Sub

 

[akviran42]

Yusuf Hocam ;

Çok teşekkür ederim emeğine sağlık. Allah razı olsun işin gücün ras gelsin

Selametle
İlyas

 

[YUSUF44]

Kod şöyle daha iyi oldu, bir önceki halinde M6 sıfır olduğunda E8'e OK yazıyordu:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [M6]) Is Nothing Then Exit Sub

If Target <> "" Then
    If Target >= 35001 Then
        numune = 13
    ElseIf Target >= 1201 Then
        numune = 8
    ElseIf Target >= 151 Then
        numune = 5
    ElseIf Target >= 26 Then
        numune = 3
    ElseIf Target >= 2 Then
        numune = 2
    Else
        GoTo 10
    End If
    [E8:Q8] = ""
    Range(Cells(8, "E"), Cells(8, numune + 4)) = "OK"
Else
10:
    [E8:Q8] = ""
End If
End Sub