Soru Hesaplanan adrese otomatik olarak bir TEXT yazdirmak

[barqin]

Arkadaslar merhaba
umarim herkesler iyidir.

Sorum su:

1. Kullanici belli bir hucreye(J9) bir rakam giriyor: ekteki ornekte bu rakam = 6
2. Bu rakami girdigi satirin sag tarafindaki bir dizi icerisinde (O9:AE9) de aranan bir text deger var. Ekteki ornekte bu aranan text deger = "PROD" ve bu Degeri de kullanici o dizi ( O9:AE9) icerisinde istedigi yere yazabilir.
3. Yapmak istedigim sey:
   • Dizi icerisindeki bu PROD hucresinin ; 1.adimdaki kullanici tarafindan girilen deger kadar sagindaki hucreye ; yani 6 hucre sagina otomatik olarak "EML" textini ekletmek.
   • Dizi icerisindeki bu PROD hucresinin yeri kullanici tarafindan degistirilebilir , eger degistirilirse haliyle EML yazacagimiz hucre de ona gore degismesi gerekecek

ben E9 F9 G9 H9 yucrelerinde bazi yardimci hesaplamalar yaptim ama isin sonunu baglayamiyorum.

Simdiden tesekkurler

 

[YUSUF44]

Aşağıdaki kodları sayfanın kod bölümüne (sayfa adına sağ tıklayıp Kod Görüntüle deyince açılan sayfaya) kopyalayıp deneyiniz. J8:J10 arasına sayı ya da O8:AE10 aralığına PROD yazdığınızda istediğiniz işlemi yapar. Belirtilen hücre aralıklarını if intersect olan satırdaki hücre adreslerini değiştirerek genişletebilirsiniz:

Private Sub Worksheet_Change(ByVal Target As Range)
If Selection.Count > 1 Then Exit Sub
a = Target.Row
If Intersect(Target, [J8:J10]) Is Nothing Then GoTo 10
    If Target = "" Then
        Set yer = Range("O" & a & ":AE" & a).Find("EML")
        If Not yer Is Nothing Then yer.ClearContents
    ElseIf IsNumeric(Target) = True Then
        Set eml = Range("O" & a & ":AE" & a).Find("EML")
        If Not eml Is Nothing Then eml.ClearContents
        Set prod = Range("O" & a & ":AE" & a).Find("PROD")
        If Not prod Is Nothing Then prod.Offset(0, Target) = "EML"
    Else
        Set eml = Range("O" & a & ":AE" & a).Find("EML")
        If Not eml Is Nothing Then eml.ClearContents
    End If
10:
If Intersect(Target, [O8:AE10]) Is Nothing Then Exit Sub
    If Target = "" Or Cells(a, "J") = "" Or IsNumeric(Cells(a, "J")) = False Then
        Set yer = Range("O" & a & ":AE" & a).Find("EML")
        If Not yer Is Nothing Then yer.ClearContents
    ElseIf IsNumeric(Cells(a, "J")) = True And Target = "PROD" Then
        Set eml = Range("O" & a & ":AE" & a).Find("EML")
        If Not eml Is Nothing Then eml.ClearContents
        Target.Offset(0, Cells(a, "J")) = "EML"
    End If

End Sub

 

[barqin]

cok tesekkurler
calisti dediginiz gibi.