Makro İle Değer Atama

[ormann]

İyi günler;
Ekli dosyada E19:E30000 arasında 1 den başlayarak sırası ile sayılar yazılı.Benim yapmak istediğim R6 'ya başlangıç sayısını S6 ya bitiş sayısını yazdığımda R8 hücresinde atanacak veriyi I sütünun da R6 ve S6 hücresindeki aralığa atayacak.Yardımcı olur musunuz?
Örneğin :R6 Hücresine 400 Sayısını;S6 Hücresine 700 sayısını yazdığımda 400-700 sayısı arasına R8 hücresindeki veriyi I sütününda karşılığına gelecek şekilde yazacak.

http://dosya.co/zwcn11j2cdu7/örnek.xls.html

 

[Erdem Akdemir]

Merhaba,

Aşağıdaki kodu deneyin.

Sub denene()

Range("I" & 18 + [R6] & ":" & "I" & 18 + [S6]) = [R8]

End Sub

 

[ormann]

Sayın Kuvari çok teşekkür ederim.Kod gayet güzel çalışıyor.Buton ile değilde R8 hücresine girilecek değeri yazdığımda otomatik olarak atayabilir mi?

 

[yanginci34]

Denermisiniz.
http://dosya.co/vai6xqrwfqwn/şartlı_değer_getirme.xls.html

 

[ormann]

Sayın Yangıncı teşekkür ederim. Çalışıyor. Fakat önceki atananları siliyor.Birde bu işlemi 2 nolu mesajımda belirttiğim şekilde otamatik olarak yapabilirmiyiz ?

 

[Erdem Akdemir]

VBA bölümünde Sayfa1'e yapıştırın.

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("R8")) Is Nothing Then Exit Sub

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Range("I" & 18 + [R6] & ":" & "I" & 18 + [S6]) = [R8]

Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

 

[yanginci34]

Denermisiniz.
http://dosya.co/fnkong4c7duv/şartlı_değer_getirme.xls.html

 

[ormann]

Çok teşekkür ederim.Ellerinize sağlık