• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Soru Küçük bir ödev

  • Konbuyu başlatan Konbuyu başlatan goko36
  • Başlangıç tarihi Başlangıç tarihi
Katılım
5 Mayıs 2020
Mesajlar
31
Excel Vers. ve Dili
İng-14.0.6023
Selamlar. Öncelikle site ve vba for excelde yeniyim. Okulumda şu tarz denklem çözülmesi için bir ödev verildi. Fakat bu denklemi çözecek a,b,c sayıları bilmediğim için kodum hep arccos hesaplama kısmında (ERROR 2036) hata veriyor. Öncelikle soracağım soru şu.
1) Yazdığım kısımlarda hata varmı? Veya nasıl güzelleştirebilirim.
2) if statementta istediğim koşulu sağlayan örnek sayılar a=-4 b=1 c=2. O adını verdiğim denklemde sonuc -1,46 cıkıyor. ama arccos 0 ile pi aralığında. hatayı bu yüzden alıyor olabilirmiyim?

ödevim olduğunu biliyorum fakat sizden ödevimi çözmekten ziyade yardımlarınızı bekliyorum.

edit: yazdığım kodu eklemeyi unutmuşum.
Kod:
Option Explicit
Function Q1(a, b) As Double
    Q1 = (a ^ 2 - 3 * b) / 9
End Function
Function R1(a, b, c) As Double
    R1 = (2 * a ^ 3 - a * 9 * b + 27 * c) / 54
End Function

Sub question3()
    Dim a, b, c, d, pi, O, Z, root1, root2, root3 As Double
        MsgBox "This program solves quadratic equation in the form of x3+ax2+bx+c=0"
        a = InputBox("Please enter the value of a")
        b = InputBox("Please enter the value of b")
        c = InputBox("Please enter the value of c")
        pi = Application.pi()
        O = ((2 * a ^ 3 - a * 9 * b + 27 * c) / 54) / (((a ^ 2 - 3 * b) / 9) ^ 1 / 3)
        Z = Application.Acos(O)
If ((R1(a, b, c) ^ 2) < (Q1(a, b) ^ 3)) Then
    root1 = (-2 * Sqr(Q1(a, b)) * Cos(Z / 3 - a / 3))
    root2 = (-2 * Sqr(Q1(a, b)) * Cos(Z + 2 * pi) / 3 - a / 3)
    root3 = (-2 * Sqr(Q1(a, b)) * Cos(Z - 2 * pi) / 3 - a / 3)
    MsgBox "First root of the equation is : " & root1 & vbNewLine & vbNewLine & "Second root of the equation is : " & root2 & vbNewLine & vbNewLine & "Third root of the equation is : " & root3
Else
    MsgBox "Your entries do not meet the required condition"
End If
End Sub
 
Trigonometrik fonksiyonlarla çalışırken, açı ölçü biriminiz "Radyan" olmalı....

Kod:
Sub Test()
    Dim Theta As Double
   
    Theta = 30 ' >>>>>>> 30 Derece
   
    MsgBox Sin(Theta * Application.pi / 180)
End Sub

.
 
Son düzenleme:
@Haluk çok teşekkür ederim cevabınız için. bir sorum daha var. aşağıda hazırladığım root2 ve root 3 aynı sonucu döndürüyor. oradaki hatam nedir? radyan olarak girmediğim için mi? yoksa işlem önceliğinden dolayı mı hata veriyor?
 
Muhtemelen yazdığınız komutlarda yanlışlıklar vardır.....

Örneğin kodun bir yerinde aşağıdaki ifade var;

Kod:
(.........) ^ 1 / 3

Burada sanki üslü bir ifade yazmaya çalışmışınız diye anlıyorum ama, bu şekilde yazılırsa kod; hesapladığı parantez içerisindeki ifadenin 1nci kuvvetini alıp sonucu 3'e böler...

Doğrusu ise;

Kod:
(.........) ^ (1 / 3)

olmalıdır....

Aşağıdaki örneğe bakmanızda fayda var, RetVal1 ve RetVal2 sonuçları farklı olacaktır...


Kod:
Sub Test2()
    Dim a As Double, b As Double, RetVal1 As Double, RetVal2 As Double
  
    a = 10
    b = 5
  
    RetVal1 = ((a ^ 2 - 3 * b) / 9) ^ 1 / 3
  
    RetVal2 = ((a ^ 2 - 3 * b) / 9) ^ (1 / 3)
  
    MsgBox RetVal1 & vbCrLf & vbCrLf & RetVal2
End Sub



Bunlar gibi daha başka yanlışlıklar da var .....

.
 
@Haluk anladım cok tesekkurler. sizce bu ödevde yapabileceğim düzeltmeler neler olabilir? teşekkürler tekrardan
 
Örnek olarak; 1. kökü hesapladığınız kod satırı yanlış bir değer hesaplıyor.

Sizin yazdığınız;

Kod:
root1 = (-2 * Sqr(Q1(a, b)) * Cos(Z / 3 - a / 3))


Olması gereken;

Kod:
root1 = -2 * Sqr(Q1(a, b)) * Cos(Z / 3) - a / 3


Tabii, kosinüsünün hesaplandığı (Z/3) değerinde "Z" değişkeninin daha önceden "Radyan" birimine çevrilmiş olması gerekli ....

Not: "Z" değerinin doğru hesaplanıp hesaplanmadığına bakmadım.

Bunun gibi, diğer satırları kontrol etmek lazım .....

.
 
@Haluk tamamdır cok tesekkurler tum satırları teker teker kontrol edeceğim.
 
Ödev daha bitmediyse, aşağıdaki koda göz atın ...

Kod:
Sub Test()
    Dim a As Double, b As Double, c As Double
    Dim root1 As Double, root2 As Double, root3 As Double
    Dim RetVal1 As Double, RetVal2 As Double, RetVal3 As Double
    
    MsgBox "This program solves quadratic equation in the form of x3+ax2+bx+c=0"
    
    a = Application.InputBox("Please enter the value of a", Type:=1)
    b = Application.InputBox("Please enter the value of b", Type:=1)
    c = Application.InputBox("Please enter the value of c", Type:=1)
    
    On Error GoTo ErrHandler:
    
    If a = 0 And b = 0 And c = 0 Then
        MsgBox "None of the coefficients are entered!", vbCritical
        Exit Sub
    End If
    
    Q = (a ^ 2 - 3 * b) / 9
    R = (2 * a ^ 3 - 9 * a * b + 27 * c) / 54
        
    If Not (R ^ 2) < (Q ^ 3) Then
        MsgBox "Your entries do not meet the required condition"
        Exit Sub
    End If
    
    Theta = Application.Acos((R / Sqr(Q ^ 3)))
    
    root1 = -2 * Sqr(Q) * Cos(Theta / 3) - a / 3
    root2 = -2 * Sqr(Q) * Cos((Theta + 2 * Application.Pi) / 3) - a / 3
    root3 = -2 * Sqr(Q) * Cos((Theta - 2 * Application.Pi) / 3) - a / 3
    
    MsgBox "First root of the equation is : " & root1 & vbNewLine & vbNewLine & _
           "Second root of the equation is : " & root2 & vbNewLine & vbNewLine & _
           "Third root of the equation is : " & root3
    
    RetVal1 = root1 ^ 3 + a * root1 ^ 2 + b * root1 + c
    RetVal2 = root2 ^ 3 + a * root2 ^ 2 + b * root2 + c
    RetVal3 = root3 ^ 3 + a * root3 ^ 2 + b * root3 + c
    
    MsgBox "Check value of function F(x):" & vbCrLf & vbCrLf & _
           "Using F(Root-1):   " & RetVal1 & vbCrLf & _
           "Using F(Root-2):   " & RetVal2 & vbCrLf & _
           "Using F(Root-3):   " & RetVal3
    
ErrHandler:
    If Err Then MsgBox Err.Description, vbCritical
End Sub

.
 
Son düzenleme:
Sayın Haluk Hocam,
Elinize sağlık, çok güzel olmuş. Affınıza sığınarak;
MsgBox "Check value of function F(x): ... ile başlayan bölgeyi isterseniz kaldırın. Hesaplamalar sırasında çok çok küçük artıklar, kökler doğru olduğu halde F(x) 'i sağlamıyor. (örnek1: a=-3, b=1, c=-1 ; örnek2: a=5, b=-4, c=-20 ; örnek3: a=-2, b=-19, c=20)
Saygılarımla
 
Sayın @Tevfik_Kursun ;

O kısmını özellikle koydum, maksat; bulunan köklerin doğruluğunu ispat ederken Excel'in davranışını göstermek....

Aslında Excel'in bazı kökler için bulduğu -E14 veya -E15 mertebesindeki çok küçük farklar, Excel'in sayıları Binary (ikili) sisteme çevirerek kullanmasından kaynaklanıyor. Ortaya çıkan farklar ise, bu çevirmeyi yaparken her zaman tam sayı olarak çevrilemediği için.

Selamlar,

.
 
Sayın Haluk Hocam,
Çok doğru.
Saygılarımla
 
Geri
Üst