２次方程式を解くマクロを作成したのですが解けません。

２次方程式を解くマクロを作成したのですが解けません。

マクロの授業で２次方程式を解くマクロを作成したのですが途中で何がなんだかわかんなくなってしまいました。
どこがどう間違っているのかわからない初心者なのでわかりやすい解説よろしくお願いします。

■二次方程式の解を求めるマクロ
マクロ名 niji
条件
課題のファイルのsheet1を開き、
A1にxの二乗の係数
C3にxの係数
E3に定数項
を入力した場合
判別式の結果より、I3に解の状態を表示させる
表示は
2つの異なる実根
重根
複素数根

のいずれかとする。

そして、J3、K3に二次方程式の解を表示させる。解は二次方程式の解の公式
より求める。
複素数は i としてあらわす。

以下作成したマクロ↓

Sub niji()

Range("A3").Select
a = ActiveCell.Formula
Range("C3").Select
b = ActiveCell.Formula
b2 = -b / 2
Range("E3").Select
c = ActiveCell.Formula
d = b * b - 4 * a * c
Range("J3,K3").Formula = ""
'ActiveCell.Formula = ""

If d > 0 Then
x1 = b2 + Sqr(d) / 2
x2 = b2 - Sqr(d) / 2
Range("J2").Select
ActiveCell.Formula = "解1"
Range("J3").Select
ActiveCell.Formula = Str$(x1)
Range("K2").Select
ActiveCell.Formula = "解2"
Range("K3").Select
ActiveCell.Formula = Str$(x2)
End If
If d = 0 Then
Range("J2").Select
ActiveCell.Formula = "x ="
Range("J3").Select
ActiveCell.Formula = Str$(b2)
End If
If d < 0 Then
d2 = Sqr(-d) / 2
Range("J2").Select
ActiveCell.Formula = "x1 ="
Range("J3").Select
ActiveCell.Formula = Str$(b2) + " +- i " + Str$(d2)
End If
If "J3" = "K3" Then
Range("I3").Select
ActiveCell.Formula = "重解"
End If
If "J3" > "K3" Then
Range("I3").Select
ActiveCell.Formula = "２つの異なる実根"
End If
If "J3" < "K3" Then
Range("I3").Select
ActiveCell.Formula = "２つの異なる実根"
End If
Range("b8").Select
End Sub

マクロ初心者なのでわかりやすい解説お願いします。

No.3 回答者： Wendy02 回答日時： 2009/06/11 00:06

こんばんは。

この内容の解説はしませんが、ユーザー定義関数で、マクロを作ってみました。
関数だけでも、出せますが、マクロなので、組み込みました。

他人のマクロは、こちらは、手を付けません。

-----------------------------------------

Sub Test1()
Dim a As Double
Dim b As Double
Dim c As Double
Dim D As Double
　a = Range("A3").Value
　b = Range("C3").Value
　c = Range("E3").Value
　Range("I3:K3").ClearContents
　D = b ^ 2 - 4 * a * c '判定式
　If D > 0 Then
　 Range("I3").Value = "二つの異なる実数解"
　 Range("J3").Value = xQuadra(a, b, c, 0)
　 Range("K3").Value = xQuadra(a, b, c, 1)
　ElseIf D = 0 Then
　 Range("I3").Value = "重解"
　 Range("J3").Value = xQuadra(a, b, c, 0)
　Else
　 Range("I3").Value = "二つの異なる虚数解"
　 'ひとつにまとめる
　 Range("J3").Value = Replace(xQuadra(a, b, c, 0), "-i", "±i", , 1)
　
　 'Range("J3").Value = xQuadra(a, b, c, 0)
　 'Range("K3").Value = xQuadra(a, b, c, 1)
　End If
　
End Sub
Function xQuadra(a As Double, b As Double, c As Double, Optional n As Long = 0)
　　Dim ret(1) As Double
　　Dim D As Double
　　Dim buf As Variant
　　Dim iSgn As Variant
　　Dim i As Variant
　　
　　D = b ^ 2 - 4 * a * c '判定式
　　
　　If a = 0 Then xQuadra = CVErr(xlErrNum): Exit Function
　　
　　If n > 0 Then n = 1: iSgn = 1
　　If n <= 0 Then n = 0: iSgn = -1
　　
　　If D >= 0 Then
　　　　ret(n) = (-b + iSgn * D ^ (1 / 2)) / 2 * a
　　　　If ret(n) = 0 Then
　　　　　　buf = 0
　　　　Else
　　　　　　buf = ret(n)
　　　　End If
　　ElseIf D < 0 Then
　　　　ret(n) = -b / 2 * a
　　　　If ret(n) = 0 Then
　　　　　　buf = ""
　　　　 Else
　　　　　 buf = ret(n)
　　　　 End If
　　　　　　
　　　　If iSgn > 0 Then
　　　　　 iSgn = "+"
　　　　Else
　　　　　 iSgn = "-"
　　　　End If
　　　　
　　　　i = ((-D) ^ (1 / 2)) / 2 * a
　　　　
　　　　If i = 1 Then
　　　　　　i = ""
　　　　End If
　　　　buf = buf & iSgn & CStr(i) & "i"
　　End If
　　xQuadra = buf
End Function

No.2 回答者： abe_onesel 回答日時： 2009/06/09 11:59

dの値が正・ゼロ・負のいずれかによって

2つの異なる実根・重根・複素数根が判断できると思うので、
＞If "J3" = "K3" Then
から下でやりたいことは上にあるifの中に組み込んでしまうのがスムーズです。

ついでに言うなら、
＞If "J3" = "K3" Then
これは、If Range("J3") = Range("K3") Then
のようにしたかったのだと推察します。
それに、重根の時はJ3セルにしか数値を入力していなくK3セルは値が無いので、
ここでこういった判断をした所で意味がありません。


少し見ずらい所があったので、
同じ処理をしつつ、簡易的に修正を入れてみました。
Ifを３つ使って判断していますが、Select Case～の方が慣れてきたら使いやすいと思います。
余裕があれば調べてみて下さい。

※ここは数学のカテゴリーでは無いので計算内容についてはご自身で検証して下さい。



Sub niji()

a = Range("A3").Value
b = Range("C3").Value
b2 = -b / 2
c = Range("E3").Value
d = b * b - 4 * a * c
Range("I2:K3").ClearContents

If d > 0 Then
x1 = b2 + Sqr(d) / 2
x2 = b2 - Sqr(d) / 2
Range("J2").Value = "解1"
Range("J3").Value = Str$(x1)
Range("K2").Value = "解2"
Range("K3").Value = Str$(x2)
Range("I3").Value = "２つの異なる実根"
End If

If d = 0 Then
Range("J2").Value = "x ="
Range("J3").Value = Str$(b2)
Range("I3").Value = "重解"
End If

If d < 0 Then
d2 = Sqr(-d) / 2
Range("J2").Value = "x1 ="
Range("J3").Value = Str$(b2) + " +- i " + Str$(d2)
Range("I3").Value = "複素数根"
End If

End Sub

No.1 回答者： optimumsoup 回答日時： 2009/06/09 11:58

当方　エクセル97ですのでそのつもりで聞いてください。

あなたのプログラムの2箇所だけ、プログラムの最初に変数宣言文を入れ、Xの2乗の項の係数をA3に入れましたら、答えが得られました。ただし、例題は実数の解のあるときですが。