• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

Katılım
18 Şubat 2008
Mesajlar
52
Excel Vers. ve Dili
excel
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
 

Ekli dosyalar

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:
Kod:
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
 
Son düzenleme:
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
 
Önceki mesajınızı tam anlamadığımdan öyle hazırlamıştım. Aşağıdaki kodu deneyiniz:

Kod:
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
 
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.
 
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
 
Aşağıdaki kodu deneyiniz. M6 hücresine girilen sayıya göre istediğiniz değişikliği yapar:

Kod:
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
 
Yusuf Hocam ;

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

Selametle
İlyas
 
Kod şöyle daha iyi oldu, bir önceki halinde M6 sıfır olduğunda E8'e OK yazıyordu:
Kod:
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
 
Geri
Üst