Maaş Programı İçin Hedef Arayı Makro yapmak.

[Huseyinkis]

Excelde maaş programım var ve bunu macro ile yaparak yenilemek istiyorum fakat excelde yaptığım formulu macro kısmını aktaramadım..


Private Sub OcakHesaplama()
Dim Brut, SSK_Mat, SSK_İc, İs_Sig, İlk_Kes, Gv_Mat, K_Gv_Mat, G_V_Or, G_V, D_V, Kes_Top, NET As Long

If Brut < 728 Then
SSK_Mat = 728
ElseIf Brut > 4738.5 Then
SSK_Mat = 4738.5
Else
SSK_Mat = Brut
End If
SSK_İc = SSK_Mat / 100 * 14
İs_Sig = SSK_Mat / 100
İlk_Kes = SSK_İc + İs_Sig
Gv_Mat = Brut - İlk_Kes
K_Gv_Mat = Gv_Mat
If K_Gv_Mat < 8800 Then
G_V_Or = 0.15
ElseIf K_Gv_Mat < 22000 Then
G_V_Or = 0.2
ElseIf K_Gv_Mat < 76200 Then
G_V_Or = 0.27
ElseIf K_Gv_Mat < 999999999 Then
G_V_Or = 0.35
End If
G_V = Gv_Mat * G_V_Or
D_V = Brut * 0.06
Kes_Top = İlk_Kes + G_V + D_V
NET = Brut - Kes_Top


bu formülde istediğim hesaplama yapılıyor fakat benim problemim ekli dosyayıda incelerseniz elimde bir burut değerin olmaması..

Excelde burut değeri bulmak için "Net Değer" veriyorum ve bunu hedef ara formulu ile "Net" değere ulaşana kadar burut değeri hesaplamasını istiyorum ve hesaplama işlemi gerçekleşiyo.. Bu işlemi macro ortamında nasıl yapabilirim yardımcı olursanız sevinirim.

Net_Deger=3500

Net_Deger.GoalSeek goal:=NET, changing:=Brut

Bunu denedim ama sanırım bukadar kolay değil

 

[hamitcan]

Aşağıdaki linkte daha önce böyle bir uygulama yapılmış, belki işinize yarar.
http://www.excel.web.tr/f48/goal-seek-hedef-ara-uygulamasini-makro-ile-yapmak-t29281.html

 

[Huseyinkis]

Slm

Hamitcan bey link için teşekkürler fakat ben zaten hedef ara formulunu gostermiş olduğunuz linkde belittiği gibi ekte koyduğum dosyada uygulamıştın sanırım problemi tam anlatamadım ama bir cözüm buldum gibi ama bundada toplamda 2 TL kusuratlardan fark ediyor .. aşağıdaki formulü daha hızlı ve kullanışlı hala nasıl getirebilirim bi detaylı incelerseniz sevinirim.



Private Sub OcakHesaplama()
Dim Brut, SSK_Mat, SSK_ic, İs_Sig, İlk_Kes, Gv_Mat, K_Gv_Mat, G_V_Or, G_V, D_V, Kes_Top, NET, aaa As Long

aaa = UserForm1.Tutar1
Brut = 0

Bas:
If Brut < 728 Then
SSK_Mat = 728
ElseIf Brut > 4738.5 Then
SSK_Mat = 4738.5
Else
SSK_Mat = Brut
End If

SSK_ic = (SSK_Mat / 100) * 14

İs_Sig = SSK_Mat / 100

İlk_Kes = SSK_ic + İs_Sig

Gv_Mat = Brut - İlk_Kes
K_Gv_Mat = Gv_Mat
If K_Gv_Mat < 8800 Then
G_V_Or = 0.15
ElseIf K_Gv_Mat < 22000 Then
G_V_Or = 0.2
ElseIf K_Gv_Mat < 76200 Then
G_V_Or = 0.27
ElseIf K_Gv_Mat < 999999999 Then
G_V_Or = 0.35
End If

G_V = Gv_Mat * G_V_Or
D_V = Brut * 0.006
Kes_Top = (İlk_Kes + G_V) + D_V
NET = Brut - Kes_Top

If NET >= aaa Then
Brut = Brut
GoTo Son:
Else
Brut = Brut + 0.01
GoTo Bas:
End If
Son:
UserForm1.Deneme1.Value = SSK_Mat
UserForm1.Deneme2.Value = SSK_ic
UserForm1.Deneme3.Value = İs_Sig
UserForm1.Deneme4.Value = Gv_Mat
UserForm1.Deneme5.Value = G_V
UserForm1.Deneme6.Value = D_V
UserForm1.Deneme7.Value = NET
UserForm1.Deneme8.Value = Brut
End Sub

 

[halit3]

ben pek anlamam ama son iki karekterini aşağıdaki gibi yuvarlıyabilirsiniz.

UserForm1.Deneme1.Value = Round(SSK_Mat, 2)
UserForm1.Deneme2.Value = Round(SSK_ic, 2)
UserForm1.Deneme3.Value = Round(İs_Sig, 2)
UserForm1.Deneme4.Value = Round(Gv_Mat, 2)
UserForm1.Deneme5.Value = Round(G_V, 2)
UserForm1.Deneme6.Value = Round(D_V, 2)
UserForm1.Deneme7.Value = Round(NET, 2)
UserForm1.Deneme8.Value = Round(Brut, 2)

 

[Huseyinkis]

Halit Bey teşekkur ederim kusurat problemini cözdüm sayılır benim asıl yapmak istediğim hedef ara işleminin textbox larda uygulamak.. yukardaki formule bakarsanız


Brut=brut+0.01 işlemi rakamlar eşitlenene kadar burut rakamı arttırıyo fakat tabi işlemi yapması zaman alıyo bunu hızlandırmak istiyorum...


şimdiden teşekkürler