excelde elle girilen bir değeri başka bir hücre değerine göre değiştirme

Katılım
7 Aralık 2011
Mesajlar
20
Excel Vers. ve Dili
2013-TÜRKÇE
Altın Üyelik Bitiş Tarihi
20-01-2023
merhaba arkadaşlar
çok araştırdım ama bir sonuca ulaşamadım.yapmak istediğim olay şöyle;
excel de bir hücreye elle girdiğim bir sayıyı başka bir hücrede bulunan bir sayıyı değiştirmek suretiyle ayarlamak.
diyelim ki a1 hücresine bir rakam girdim. b1 hücresinde bulunan başka bir rakamı büyütüp küçülterek a1 hücresindeki rakamın büyüyüp küçülmesini sağlamak istiyorum.
aslında a1 hücresindeki değeri elle girmek yerine başka bir yerden formülle alsaydım o zaman işim kolaydı.
ancak a1 hücresindeki değeri elle girme zorunluluğum var.
excel formülleriyle yada makro ile bu olayın bir çözümü varmı?
çok acil yardım bekliyorum.
 
Son düzenleme:
Katılım
24 Nisan 2005
Mesajlar
3,671
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
.. a1 hücresindeki rakamın büyüyüp küçülmesini sağlamak istiyorum...
A1 hücresindeki rakam hangi koşula yada kurala göre büyüyüp küçülecek?

B1 e girdiğiniz rakam onu nasıl etkilemesi gerekiyor?

Sayfanın kod bölümüne yapıştırın.
B1 her değer girdiğinizde kırmızı olan kod A1 ile B1 i çarpar sonucu A1 yazar
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    If Intersect(Target, Range("B1:B1")) Is Nothing Then Exit Sub
       veri = Target.Value
       Range("A1").Value =[B] [COLOR=Red]veri * Range("A1").Value[/COLOR][/B]
       
End Sub
 
Katılım
7 Aralık 2011
Mesajlar
20
Excel Vers. ve Dili
2013-TÜRKÇE
Altın Üyelik Bitiş Tarihi
20-01-2023
A1 hücresindeki rakam hangi koşula yada kurala göre büyüyüp küçülecek?

B1 e girdiğiniz rakam onu nasıl etkilemesi gerekiyor?

Sayfanın kod bölümüne yapıştırın.
B1 her değer girdiğinizde kırmızı olan kod A1 ile B1 i çarpar sonucu A1 yazar
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    If Intersect(Target, Range("B1:B1")) Is Nothing Then Exit Sub
       veri = Target.Value
       Range("A1").Value =[B] [COLOR=Red]veri * Range("A1").Value[/COLOR][/B]
       
End Sub

Değerli "asri" öncelikle cevabın için çok teşekkür ederim.benim istediğime yakın bir çözüm olmuş. bir örnek dosya gönderdim. excel de formülle yaptım. ancak örnekte b sütunundaki değerleri elle girme zorunluluğum var. bu yüzden örnekte d sütunundaki değerler b sütununu nasıl etkiliyorsa makro da öyle yazılmalı.
 

Ekli dosyalar

Katılım
24 Nisan 2005
Mesajlar
3,671
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
Değerli "asri" öncelikle cevabın için çok teşekkür ederim.benim istediğime yakın bir çözüm olmuş. bir örnek dosya gönderdim. excel de formülle yaptım. ancak örnekte b sütunundaki değerleri elle girme zorunluluğum var. bu yüzden örnekte d sütunundaki değerler b sütununu nasıl etkiliyorsa makro da öyle yazılmalı.
Bu şekilde deneyin.
D kolonun her hücre değeri değiştiğinde B etkilenir

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    If Intersect(Target, Range("D2:D10000")) Is Nothing Then Exit Sub
       satir = Target.Row
       '=EĞER(Sayfa2!A2="";"";Sayfa2!A2*Sayfa1!A2)*D2
       If Sheets("Sayfa2").Cells(satir, "A").Value <> "" Then
          Cells(satir, "B").Value = (Sheets("Sayfa2").Cells(satir, "A").Value * Cells(satir, "A").Value) * Cells(satir, "D").Value
       Else
          Cells(satir, "B").Value = 0
       End If
End Sub
 
Katılım
7 Aralık 2011
Mesajlar
20
Excel Vers. ve Dili
2013-TÜRKÇE
Altın Üyelik Bitiş Tarihi
20-01-2023
Bu şekilde deneyin.
D kolonun her hücre değeri değiştiğinde B etkilenir

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    If Intersect(Target, Range("D2:D10000")) Is Nothing Then Exit Sub
       satir = Target.Row
       '=EĞER(Sayfa2!A2="";"";Sayfa2!A2*Sayfa1!A2)*D2
       If Sheets("Sayfa2").Cells(satir, "A").Value <> "" Then
          Cells(satir, "B").Value = (Sheets("Sayfa2").Cells(satir, "A").Value * Cells(satir, "A").Value) * Cells(satir, "D").Value
       Else
          Cells(satir, "B").Value = 0
       End If
End Sub
sizin yazdığınız bu makro çalıştı.teşekkür ederim.ancak b sütunundaki değerleri elle girmeliyim. başka bir hücreye bağlı olmamalı.yani benim gönderdiğim örnekte b sütunundaki hücreler sayfa2 den değer alıyordu.ben bunu istemiyorum. b sütununa değeri elle girmeliyim. belki siz doğrusunu yazdınız ama ben hiç makro bilmediğim için anlamamış olabilirim.kusura bakmayın. ama dediğim gibi b sütunu başka yerden değer almamalı. d sütunu benim b sütununa elle girdiğim değeri örnekteki gibi etkilemeli.
sizin yazdığını makroda da sanırım b sütunu sayfa2 deki değerlere göre çalışıyor.
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Anlaşılması zor bir durum.

Sayın asri'nin izniyle eğer istediğiniz, B sütununa girdiğiniz sayıyı, A ve D sütunundaki sayılarla çarpıp yine B sütununa yazmaksa (örneğin A2''de 1, D2'de 2 yazıyorken B2'ye 100 yazdığınızda B2'de 1*2*100 işlemi ile 200 sonucunu görmekse) aşağıdaki kodları deneyiniz:

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    son = Cells(Rows.Count, "B").End(3).Row + 1
    If Intersect(Target, Range("B2:B" & son)) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    If IsNumeric(Target) = False Then Exit Sub
    Application.EnableEvents = False
    Target = Target * Target.Offset(0, -1) * Target.Offset(0, 2)
    Application.EnableEvents = True
End Sub
 
Katılım
7 Aralık 2011
Mesajlar
20
Excel Vers. ve Dili
2013-TÜRKÇE
Altın Üyelik Bitiş Tarihi
20-01-2023
Anlaşılması zor bir durum.

Sayın asri'nin izniyle eğer istediğiniz, B sütununa girdiğiniz sayıyı, A ve D sütunundaki sayılarla çarpıp yine B sütununa yazmaksa (örneğin A2''de 1, D2'de 2 yazıyorken B2'ye 100 yazdığınızda B2'de 1*2*100 işlemi ile 200 sonucunu görmekse) aşağıdaki kodları deneyiniz:

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    son = Cells(Rows.Count, "B").End(3).Row + 1
    If Intersect(Target, Range("B2:B" & son)) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    If IsNumeric(Target) = False Then Exit Sub
    Application.EnableEvents = False
    Target = Target * Target.Offset(0, -1) * Target.Offset(0, 2)
    Application.EnableEvents = True
End Sub
teşekkür ederim "YUSUF44".ama istediğim bu değil.bakın örnek dosyada sadece b ve d sütununa odaklanalım. ben b sütununda örneğin b2 hücresine elle bir değer giriyorum.ama daha sonra elle girdiğim bu değerin d dütununda d2 hücresinde bulunan 1 rakamını arttırıp azaltmak suretiyle b2 hücresindeki değeri değiştirebilmek istiyorum. işin bundan sonraki kısmı yani b2 deki değeri a2 ile çarparak c2 ye yazdırmak zaten excel formülüyle yapılan basit bişey. işin bu kısmını zaten excelde hallediyorum.benim sıkıntım b2 ye elle girdiğim bir değeri d2 deki rakamı değiştirerek değiştirmek.
Tabi bu işlemi yaparken örnek dosyada d2 hücresindeki değer değişimi b2 hücresini nasıl etkiliyorsa makroda o şekilde yazılmalı.diyelim ki b2 ye elle "100" girdim. d2 deki "1" değerini "1,1" yaptığımda d2 "110" olmalı. d2 yi "1,2" yaptığımda "120" olmalı. ama d2 yi tekrar "1" yaptığımda b2 deki değerde tekrar ilk girdiğim değere dönmeli (yani 100 olmalı).çok uzun oldu kusura bakmayın ama umarım anlatabilmişimdir.aslında kısaca benim örnek dosyada yaptığımdan tek fark b sütunudaki değerleri elle girme zorunluluğumun olması. b sütunundaki değerler başak bir hücreden formülle değer almamalı. ben elle girmeliyim.
 

Ekli dosyalar

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Anlaşılması ve çözümü zor bir istek olmuş. Yardımcı sütun kullanmadan yapılabilir mi bilmiyorum. E sütununu yardımcı sütun olarak kullanarak aşağıdaki kodlarla yapılabilir. Kod B sütununda değişiklik olduğunda bu değer E sütununa yazmakta, daha sonra D sütunu değiştiğinde ise E sütunundaki değerle D sütunundaki değeri çarparak B sütununa yazmaktadır. İsterseniz E sütununu gizleyebilirsiniz:

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    son = Cells(Rows.Count, "B").End(3).Row + 1
    If Intersect(Target, Range("D2:D" & son)) Is Nothing Then GoTo 10
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    If IsNumeric(Target) = False Then Exit Sub
    Application.EnableEvents = False
    Target.Offset(0, -2) = Target * Target.Offset(0, 1)
    Application.EnableEvents = True
10:
    If Intersect(Target, Range("B2:B" & son)) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    If IsNumeric(Target) = False Then Exit Sub
    Application.EnableEvents = False
    Target.Offset(0, 3) = Target
    Application.EnableEvents = True

End Sub
 
Katılım
7 Aralık 2011
Mesajlar
20
Excel Vers. ve Dili
2013-TÜRKÇE
Altın Üyelik Bitiş Tarihi
20-01-2023
Anlaşılması ve çözümü zor bir istek olmuş. Yardımcı sütun kullanmadan yapılabilir mi bilmiyorum. E sütununu yardımcı sütun olarak kullanarak aşağıdaki kodlarla yapılabilir. Kod B sütununda değişiklik olduğunda bu değer E sütununa yazmakta, daha sonra D sütunu değiştiğinde ise E sütunundaki değerle D sütunundaki değeri çarparak B sütununa yazmaktadır. İsterseniz E sütununu gizleyebilirsiniz:

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    son = Cells(Rows.Count, "B").End(3).Row + 1
    If Intersect(Target, Range("D2:D" & son)) Is Nothing Then GoTo 10
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    If IsNumeric(Target) = False Then Exit Sub
    Application.EnableEvents = False
    Target.Offset(0, -2) = Target * Target.Offset(0, 1)
    Application.EnableEvents = True
10:
    If Intersect(Target, Range("B2:B" & son)) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    If IsNumeric(Target) = False Then Exit Sub
    Application.EnableEvents = False
    Target.Offset(0, 3) = Target
    Application.EnableEvents = True

End Sub
çok zahmet oldu size ama gerçekten tam istediğim olmuş. E sütununu gizleyerek kulllanmak hiç sıkıntı değil. önemli olan elle değer girdiğim b sütununun d ye göre değişebiliyor olması ve b sütununun görünür olması.
çok teşekkür ediyorum.emeğinize sağlık.
 
Üst