Hücredeki İF formülünü makro olarak yazmak çevirmek

[Amaxx]

Merhaba arkadaşlar aşağıdaki formülü (E1:E5252) sütununa uyguladım. Ama Vba da nasıl bir kod kullanarak kolaylayabiliriz?


EĞER(F6>0;F6;EĞER(G6>0;G6*$C$1;EĞER(H6>0;H6*$D$1))

 

[dEdE]

Merhaba,
Yukarıdaki formül hangi hücrede acaba? Ayrıca simgenin yerinde sıfır mı var? Yani D10 mu yazıyor?

 

[fedeal]

istediginiz bu olabilirmi?
sonucu "ı" hücresine yazıyor.
Sub başla()
For i = 1 To 5252
If Range("f" & i).Value <> "" Then Range("I" & i).Value = ""
If Range("f" & i).Value > 0 Then Range("I" & i).Value = Range("f" & i).Value
If Range("g" & i).Value > 0 Then Range("I" & i).Value = Range("g" & i).Value * Range("c1").Value
If Range("h" & i).Value > 0 Then Range("I" & i).Value = Range("h" & i).Value * Range("d1").Value
Next
End Sub

 

[Amaxx]

Formül Tüm E sütununa Yazdım aşağı doğru sürükleyerek kopyaladım. Simge yerinde $D$1 ; ) var... aşağıda karakterlere boşluk ekledim simgeye dönüşmesin diye

EĞER(F5207>0;F5207;EĞER(G5207>0;G5207*$C$1;EĞER(H5207>0;H5207*$D$1 ; )

 

[Amaxx]

Sn. Fedeal Teşekkür ederim tam istediğim gibi olmuş.... peki buna şöyle birşey ekleyebilir miyiz?

F, G, H, hücrelerinden en az 2 tanesi veya 3 tanesi doluysa en büyük olan değeri almak istesek nasıl olur.... ve de bu kodlar başla düğmesi ile değil de F, G, H, hücrelerden birinde değişiklik yapıldığında sonucu almak istiyorum.

 

[fedeal]

kodları şunlarla geğiştirelim

Sub başla()
sds = Sheets("sayfa1").Range("f65536").End(xlUp).Row
For i = 1 To sds
Range("I" & i).Value = "=IF(RC[-3]=MAX(RC[-3],RC[-2],RC[-1]),RC[-3],IF(RC[-2]=MAX(RC[-3],RC[-2],RC[-1]),RC[-2]*R1C[-6],IF(RC[-1]=MAX(RC[-3],RC[-2],RC[-1]),RC[-1]*R1C[-5],"""")))"
Next
End Sub

yalnız hesaplatmayı yapamadım bu kodlar sayfa1 f sütununun son dolu satırına kadar

=EĞER(F1=MAK(F1;G1;H1);F1;EĞER(G1=MAK(F1;G1;H1);G1*C$1;EĞER(H1=MAK(F1;G1;H1);H1*D$1;"")))
formülünü ı sütununa uyguluyor.

 

[Amaxx]

Sn. Fedeal Çok Teşekkür ederim...Ben hesaplamayı Kontrol Ettim...

Süper Olmuş............ Elinize emeğinize sağlık

 

[fedeal]

pardon sorunun altını okumamışım f,g,h sütunlarına deger girince makro çalışması için

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [f:h]) Is Nothing Then Exit Sub
For i = 1 To sds
Range("I" & i).Value = "=IF(RC[-3]=MAX(RC[-3],RC[-2],RC[-1]),RC[-3],IF(RC[-2]=MAX(RC[-3],RC[-2],RC[-1]),RC[-2]*R1C[-6],IF(RC[-1]=MAX(RC[-3],RC[-2],RC[-1]),RC[-1]*R1C[-5],"""")))"
Next
End Sub
butonu kaldırıp öteki kodları silebilirsiniz.

pardon düzeltiyorum bir satırı unutmuşum

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [f:h]) Is Nothing Then Exit Sub
Sds = Sheets("sayfa1").Range("f65536").End(xlUp).Row
For i = 1 To Sds
Range("I" & i).Value = "=IF(RC[-3]=MAX(RC[-3],RC[-2],RC[-1]),RC[-3],IF(RC[-2]=MAX(RC[-3],RC[-2],RC[-1]),RC[-2]*R1C[-6],IF(RC[-1]=MAX(RC[-3],RC[-2],RC[-1]),RC[-1]*R1C[-5],"""")))"
Next
End Sub

ayrıca 3.mesajdaki dosyayı güncelledim.iyi çalışmalar.

 

[Amaxx]

Evet woksheet change' e uyarlamıştım.... sağolun.