ＶＢＡの天才来てください

二次関数の解を求めるプログラムを作成するのが目的です。

平方根はsqr関数を使うのが条件です。

ax^2+bx +cが基本式になり

(A,3)がaに(B,3)がｂに(C,3)がｃになるようにして考えます。

でた２解を(A,6)(B,6)に表示します。

もし虚数解なら(A,6)に「解なし」と表示するようにして、重解の場合は(A,6)にだけ表示されるように

プログラミングを作成する。という内容です。

何時間考えてもできないので助けてください。

No.3 ベストアンサー 回答者： t_fumiaki 回答日時： 2017/02/04 18:41

No.2続き

goto分使うの止めよう

Sub WK()
Dim A As Variant
Dim B As Variant
Dim C As Variant
Dim D As Variant
Dim Sh1 As Worksheet
Set Sh1 = Worksheets("Sheet1")

A = Sh1.Range("A3").Value
B = Sh1.Range("B3").Value
C = Sh1.Range("C3").Value
D = B * B - 4 * A * C
If D < 0 Then
Sh1.Range("A6").Value = "解なし"
ElseIf D = 0 Then
Sh1.Range("A6").Value = (-1 * B + Sqr(D)) / (2 * A)
Else
Sh1.Range("A6").Value = (-1 * B - Sqr(D)) / (2 * A)
Sh1.Range("B6").Value = (-1 * B + Sqr(D)) / (2 * A)
End If

Application.StatusBar = False
End Sub

この回答へのお礼

僕もこのようなプログラミング作ったのですが、「実行エラー９　インデックスが有効範囲にありません」

というエラー表示が出てきます。

回答していただいた、プログラミングも同じようなエラーがでました。

Sub final4()
Sheets("f4").Select
Dim A As Integer
Dim B As Integer
Dim C As Integer

Cells(3, 1) = A
Cells(3, 2) = B
Cells(3, 3) = C

Dim var1, var2 As Integer

var1 = (B * (-1) + sqr(B * B - 4 * A * C)) / 2 / A
var2 = (B * (-1) - sqr(B * B - 4 * A * C)) / 2 / A

If (B * B - 4 * A * C) < 0 Then
Range("A6") = "解なし"

ElseIf (B * B - 4 * A * C) > 0 Then
Cells(6, 1) = var1
Cells(6, 2) = var2

ElseIf (B * B - 4 * A * C) = 0 Then
Cells(6, 1) = (B * (-1)) / 2 / A
End If

ちなみに自分が作ったのがこれです。

何か悪いかわかりません。
回答お願いします。

お礼日時：2017/02/04 22:31

No.4 回答者： t_fumiaki 回答日時： 2017/02/05 05:53

チャント動くよ。

回答したWorksheets("Sheet1")
あなたのSheets("f4").Select

開いたエクセルに、Sheet1とかf4の名前のシートが無いと言ってるンだけど・・・。

この回答へのお礼

できました( ﾟДﾟ)！
めちゃ助かりました。！
ありがとうございました！

お礼日時：2017/02/05 23:49

No.2 回答者： t_fumiaki 回答日時： 2017/02/04 18:18

ラベルつけるの忘れたからもう一回

そのシート名をSheet1とした場合の例
天才で無くても出来る

Sub WK()
Dim A As Variant
Dim B As Variant
Dim C As Variant
Dim D As Variant
Dim Sh1 As Worksheet
Set Sh1 = Worksheets("Sheet1")

A = Sh1.Range("A3").Value
B = Sh1.Range("B3").Value
C = Sh1.Range("C3").Value
D = B * B - 4 * A * C
If D < 0 Then
Sh1.Range("A6").Value = "解なし"
GoTo E4
ElseIf D = 0 Then
Sh1.Range("A6").Value = (-1 * B + Sqr(D)) / (2 * A)
Else
Sh1.Range("A6").Value = (-1 * B - Sqr(D)) / (2 * A)
Sh1.Range("B6").Value = (-1 * B + Sqr(D)) / (2 * A)
End If

E4:
Application.StatusBar = False
End Sub

No.1 回答者： t_fumiaki 回答日時： 2017/02/04 18:17

そのシート名をSheet1とした場合の例

天才で無くても出来る

Sub WK()
Dim A As Variant
Dim B As Variant
Dim C As Variant
Dim D As Variant
Dim Sh1 As Worksheet
Set Sh1 = Worksheets("Sheet1")

A = Sh1.Range("A3").Value
B = Sh1.Range("B3").Value
C = Sh1.Range("C3").Value
D = B * B - 4 * A * C
If D < 0 Then
Sh1.Range("A6").Value = "解なし"
GoTo E4
ElseIf D = 0 Then
Sh1.Range("A6").Value = (-1 * B + Sqr(D)) / (2 * A)
Else
Sh1.Range("A6").Value = (-1 * B - Sqr(D)) / (2 * A)
Sh1.Range("B6").Value = (-1 * B + Sqr(D)) / (2 * A)
End If

Application.StatusBar = False

End Sub