Hesaplamaları Makro İle Butona Tanımlama

[manly]

Ekte gönderdiğim dosyayı açtığınızda MENÜ butonuna tıkladığınızda, MAVİ renkli butonun altındaki hesaplamaların butona tanımlanmasını istiyorum.

 

[numan şamil]

Merhaba
sonuçları D5,D6,D7 hücrelerine yazdırılacağını varsayarsak

Private Sub CommandButton3_Click()
Dim s1 As Worksheet
Set s1 = Sheets("Kesifveri")
s1.Range("[COLOR="Red"]D5[/COLOR]") = (WorksheetFunction.RoundUp(s1.Range("D2") / s1.Range("G2"), 0)) * s1.Range("F2")
s1.Range("[COLOR="Red"]D6[/COLOR]") = WorksheetFunction.RoundUp(s1.Range("D2") * s1.Range("K2"), 0)
s1.Range("[COLOR="Red"]D7[/COLOR]") = WorksheetFunction.RoundUp(s1.Range("D2") * s1.Range("P2"), 0)
End Sub

 

[manly]

Private Sub CommandButton3_Click()

Dim s1 As Worksheet
Set s1 = Sheets("Kesifveri")
s1.Range("H2") = (WorksheetFunction.RoundUp(s1.Range("D2") / s1.Range("G2"), 0)) * s1.Range("F2")
s1.Range("L2") = WorksheetFunction.RoundUp(s1.Range("D2") * s1.Range("K2"), 0)
s1.Range("Q2") = WorksheetFunction.RoundUp(s1.Range("D2") * s1.Range("P2"), 0)
s1.Range("V2") = s1.Range("U2") * s1.Range("H2")
s1.Range("AA2") = s1.Range("Z2") * s1.Range("H2")
s1.Range("AF2") = s1.Range("AE2") * s1.Range("H2")
s1.Range("AK2") = s1.Range("AJ2") * s1.Range("H2")

End Sub

Hocam öncelikle yol gösterdiğiniz için teşekkür ederim. Ben bir satır için gerekli formülleri bu şekilde düzenledim. Fakat o kadar çok satır varki. Bunu nasıl belirtebilirim.

 

[manly]

Yardım lütfen

 

[askm]

Dosyanızda biraz daha veri eklenmiş olarak ekleseniz daha iyi olurdu. Aşağıdaki şekilde deneyin.

Private Sub CommandButton3_Click()
Dim SonSat As Long
Dim s1 As Worksheet
Set s1 = Sheets("Kesifveri")
SonSat = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To SonSat
s1.Range("H" & i) = (WorksheetFunction.RoundUp(s1.Range("D" & i) / s1.Range("G" & i), 0)) * s1.Range("F" & i)
s1.Range("L" & i) = WorksheetFunction.RoundUp(s1.Range("D" & i) * s1.Range("K" & i), 0)
s1.Range("Q" & i) = WorksheetFunction.RoundUp(s1.Range("D" & i) * s1.Range("P" & i), 0)
s1.Range("V" & i) = s1.Range("U" & i) * s1.Range("H" & i)
s1.Range("AA" & i) = s1.Range("Z" & i) * s1.Range("H" & i)
s1.Range("AF" & i) = s1.Range("AE" & i) * s1.Range("H" & i)
s1.Range("AK" & i) = s1.Range("AJ" & i) * s1.Range("H" & i)
Next
End Sub

 

[askm]

Bu arada Combobox a veriler yanlış geliyor. Başlık kısmı gelmemesi gerekir. Programı başkalarının da kullanacağı düşünülürse yanlışlıkla başlık kısmını seçtiğinde hata verecektir. (Formülden dolayı) Userform Activite kısmını aşağıdaki şekilde değiştirin.

Private Sub UserForm_Activate()
Dim SonSat As Long
Dim s1 As Worksheet
Set s1 = Sheets("Kesifveri")
SonSat = s1.Range("A" & Rows.Count).End(xlUp).Row
ComboBox1.RowSource = "Kesifveri!A2:A" & SonSat
End Sub

 

[manly]

Çok teşekkür ederim. Sağolun...

 

[askm]

Rica ederim.

 

[manly]

Hesaplamalarda bir sorun yaşıyorum. Sarı renkli yerlere hesaplat dediğim halde veriler gelmiyor. Arada tutukluk yapıyor gibi bir durum var.

 

[manly]

yardım lütfen

 

[manly]

Sorunu bu şekilde çözdüm sanırım...

Private Sub Worksheet_Activate()
Dim SonSat As Long
Dim s1 As Worksheet
Set s1 = Sheets("Kesifveri")
SonSat = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To SonSat
s1.Range("H" & i) = (WorksheetFunction.RoundUp(s1.Range("D" & i) / s1.Range("G" & i), 0)) * s1.Range("F" & i)
s1.Range("L" & i) = WorksheetFunction.RoundUp(s1.Range("D" & i) * s1.Range("K" & i), 0)
s1.Range("Q" & i) = WorksheetFunction.RoundUp(s1.Range("D" & i) * s1.Range("P" & i), 0)
s1.Range("V" & i) = s1.Range("U" & i) * s1.Range("H" & i)
s1.Range("AA" & i) = s1.Range("Z" & i) * s1.Range("H" & i)
s1.Range("AF" & i) = s1.Range("AE" & i) * s1.Range("H" & i)
s1.Range("AK" & i) = s1.Range("AJ" & i) * s1.Range("H" & i)
Next

End Sub