Hücreye girilen değeri sabit bir değerle toplatmak

Katılım
5 Ocak 2015
Mesajlar
8
Excel Vers. ve Dili
11 türkçe
A1 de sabit bir sayı var. 4,95 mesela.
A2 de bir başlık var.
A3 ve aşağısında değerler girilecek.

İstediğim: A3'e örneğin 10 yazıp entere bastığımda otomatik olarak 4,95 ile toplayıp hücrede 14,95 çıkakacak. sonraki satıra ne yazarsam yazayım entere basınca 4,95 ile yani A1 ile toplayıp sonucunu hücereye yazması.

Not: Makro nedir bilmiyorum, sadece excelde basit formülleri yapabiliyorum.
 

Barons

Altın Üye
Katılım
14 Mayıs 2005
Mesajlar
967
Excel Vers. ve Dili
Microsoft Ofis 365
Altın Üyelik Bitiş Tarihi
06-01-2040
böyle bir şeymi istediğiniz
 

burhancavus61

Altın Üye
Katılım
13 Mayıs 2005
Mesajlar
761
Excel Vers. ve Dili
2010 Türkçe
Altın Üyelik Bitiş Tarihi
03.11.2024
bende pek anlamadım ama böyle bişeymi bilemedim
 

Ekli dosyalar

EmrExcel16

Destek Ekibi
Destek Ekibi
Katılım
1 Kasım 2012
Mesajlar
1,524
Excel Vers. ve Dili
Office 365 Türkçe
Aşama aşama izah ederseniz yapmaya çalışırım.
Bu kodları sayfanın kod bölümüne yapıştırın.

Sayfanın kod bölümü = sayfa ismi üzerinde sağ tıkla => kod görüntüle => gelen ekranda sayfa ismi yazan yere çift tıkla gelen beyaz ekrana kodları yapıştır bu sayfayı kapat. Dosyayı kaydederken farklı kaydet makro içerebilen dosya olarak kaydet *xlsm uzantılı.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [A3:A10000]) Is Nothing Then Exit Sub
    On Error Resume Next
    Application.EnableEvents = False
    Target = Target + [A1]
    Application.EnableEvents = True
End Sub
 
Son düzenleme:
Katılım
5 Ocak 2015
Mesajlar
8
Excel Vers. ve Dili
11 türkçe
Bu kodları sayfanın kod bölümüne yapıştırın.

Sayfanın kod bölümü = sayfa ismi üzerinde sağ tıkla => kod görüntüle => gelen ekranda sayfa ismi yazan yere çift tıkla gelen beyaz ekrana kodları yapıştır bu sayfayı kapat. Dosyayı kaydederken farklı kaydet makro içerebilen dosya olarak kaydet *xlsm uzantılı.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [A3:A10000]) Is Nothing Then Exit Sub
    On Error Resume Next
    Application.EnableEvents = False
    Target = Target + [A1]
    Application.EnableEvents = True
End Sub


Çok teşekkür ederim, sihir gibi geldi :)

Fakat şöyle bir durum var; ben istediğim kolay anlaşılsın dye tek sütun örneği üzerinden sordum. Yan yana örneğin 10 sütunda bu işlemi yapmasını istesem makroyu nasıl düzenlemek gerekiyor?

Benim gerçek dosyamda bu işleme AA'sonra AL'ye kadar ihtiyacım var.Verdiğiniz kodda A yerine AA yazıp istediğim sütunda ilgili işlemi yaptırdım ama dediğim gibi AL ye kadar yapmasını istesem ne gibi bir değişiklik yapmak gerekecek?
 

EmrExcel16

Destek Ekibi
Destek Ekibi
Katılım
1 Kasım 2012
Mesajlar
1,524
Excel Vers. ve Dili
Office 365 Türkçe
Çok teşekkür ederim, sihir gibi geldi :)

Fakat şöyle bir durum var; ben istediğim kolay anlaşılsın dye tek sütun örneği üzerinden sordum. Yan yana örneğin 10 sütunda bu işlemi yapmasını istesem makroyu nasıl düzenlemek gerekiyor?

Benim gerçek dosyamda bu işleme AA'sonra AL'ye kadar ihtiyacım var.Verdiğiniz kodda A yerine AA yazıp istediğim sütunda ilgili işlemi yaptırdım ama dediğim gibi AL ye kadar yapmasını istesem ne gibi bir değişiklik yapmak gerekecek?
Kodları şu şekilde değiştirin.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [AA3:AL10000]) Is Nothing Then Exit Sub
    On Error Resume Next
    Application.EnableEvents = False
    Target = Target + Cells(1, Target.Column)
    Application.EnableEvents = True
End Sub
 
Katılım
5 Ocak 2015
Mesajlar
8
Excel Vers. ve Dili
11 türkçe
Kodları şu şekilde değiştirin.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [AA3:AL10000]) Is Nothing Then Exit Sub
    On Error Resume Next
    Application.EnableEvents = False
    Target = Target + Cells(1, Target.Column)
    Application.EnableEvents = True
End Sub
Emeğiniz ve ayırdığınız vaktiniz için çok teşekkür ederim. Çok güzel oldu.
 
Üst