Kodu oluşturamadim

[muratkayabasi82]

Seçili hücre aralığı belirlenen aralıkta ise.. Makro Kodu lazım.




Örnegin B5:G27 araligi = a I5:N27 aralığı da= b olsun
Eğer seçili alan B10:G10 ise yani (a) nın içinde ise textbox1 e 100 yazsın
Eğer seçili alan I15:N15 ise yani (b) nın içinde ise textbox1 e 200 yazsın
Devam ederek gidiyor.



Yardim için tesekkurler

 

[Korhan Ayhan]

Deneyiniz.

Sub TEST()
    Set A = Range("B5:G27")
    Set B = Range("I5:N27")
    If Intersect(Selection, A) Then
        TextBox1 = 100
    End If
    If Intersect(Selection, B) Then
        TextBox1 = 200
    End If
End Sub

 

[muratkayabasi82]

Korhan bey kod sizde çalıştı mı? Bende hata verdi.

 

[alicimri]

Aşağıdaki kodu deneyin.

If Replace(Selection.Address, "$", "") = "B5:G27" Then TextBox1 = 100
If Replace(Selection.Address, "$", "") = "I5:N27" Then TextBox1 = 200

 

[muratkayabasi82]

Ali bey sizin kodda B5:G27 aralığı seçili ise çalışıyor. Ancak benim istediğim mesele B10:G10 veya B15:G15 araligi seçili ise textbox a 100 yazsın şeklinde idi.

 

[muratkayabasi82]

Tamam kodu buldum. İlgilen arkadaşlara teşekkürler.

 

[alicimri]

Çözümünü ulumuşsun bu da alternatif olsun.

If Not Intersect(Selection(1), Range("B5:G27")) Is Nothing And Not Intersect(Selection(Selection.Count), Range("B5:G27")) Is Nothing Then TextBox1.Value = 100

 

[Korhan Ayhan]

Denemeden kodu önermiştim.

Aşağıdaki kodu deneyebilirsiniz.

Private Sub CommandButton1_Click()
    Liste_1 = Array("B5:G27", "I5:N27", "P5:U27", "B31:G53", "I31:N53", "P31:U53", "B57:G79", "I57:N79", "P57:U79")
    Liste_2 = Array(100, 101, 102, 103, 104, 105, 106, 107, 108)
    
    For X = 0 To UBound(Liste_1)
        Set Test = Intersect(Selection, Range(Liste_1(X)))
        If Not Test Is Nothing Then TextBox1 = Liste_2(X)
    Next
End Sub

 

[alicimri]

Sayın Korhan Ayhan Kodlarınız;
1- "A4:B10" gibi liste_1 deki aralıklardan taşan seçimlerde de de sonuç veriyor.
2- "A4:B!0;I7:I10" veya "B5:I10" gibi seçimlerde ise içerdiği 2 aralıktan ikincisinin değerini veriyor.
Sizin kodlarınızdan yararlanarak aşağıdaki çözümü ürettim.

On Error Resume Next
 Liste_1 = Array("B5:G27", "I5:N27", "P5:U27", "B31:G53", "I31:N53", "P31:U53", "B57:G79", "I57:N79", "P57:U79")
    Liste_2 = Array(100, 101, 102, 103, 104, 105, 106, 107, 108)
      For X = 0 To UBound(Liste_1)
kesişim = Intersect(Selection, Range(Liste_1(X))).Address
kendisi = Selection.Address
If kesişim = kendisi Then
yaz = Liste_2(X)
Exit For
End If
Next
TextBox1.Value = yaz

 

[Korhan Ayhan]

Ali Bey,

Ben alanın kenarından köşesinden temas etmesi yeterlidir diye düşünmüştüm. Bu sebeple bire bir eşleşme koşulunu eklemedim.

Sizin yaptığınız ekleme kodu daha işlevsel hale getirmiş.

Teşekkürler.