Excel VBA 質問スレッド №1557 (解決済)

なんでエラーになるのかわかりません

投稿者 : 真田幸村     投稿日時 : 2023/09/07(Thu) 01:13:52     OS : 未指定     EXCEL : 未指定
友達に以下の内容を作りたいと相談してこのプログラムが返ってきました。とりあえずそのまま入力してみましたが上手くいきません。やってみるとsubまたはFunctionが定義されていないとでます、どうすれば良いのでしょうか?



- [ ] execl VBA    ボタンを押してゲームをスタートする。1〜20の範囲からランダムで一つ数を選んでプレイヤーがその数の素因数分解の結果を解答として記入し、その回答が正解だったら素因数分解した数を得点として加算して、次の範囲(範囲は20ずつ上がる)で同じことをし、不正解だったら同じ範囲からまた出題して、5回間違ったら終了する。特点はセルA1に表示しておく
- [ ]
- [ ] Sub StartGame()
- [ ] '初期化
- [ ] Dim score As Integer
- [ ] Dim wrong As Integer
- [ ] Dim num As Integer
- [ ] Dim ans As String
- [ ] Dim correct As Boolean
- [ ] Dim range As Integer
- [ ] score = 0
- [ ] wrong = 0
- [ ] range = 20
- [ ]
- [ ] 'ゲーム開始
- [ ] Do While wrong < 5
- [ ] num = Int(Rnd() * range) + 1
- [ ] ans = InputBox(num & "の素因数分解の結果を入力してください。例:12=2*2*3")
- [ ] correct = CheckAnswer(num, ans)
- [ ] If correct Then '正解なら
- [ ] score = score + num
- [ ] range = range + 20
- [ ] MsgBox "正解です!得点は" & score & "点です。次の問題に進みます。"
- [ ] Else '不正解なら
- [ ] wrong = wrong + 1
- [ ] MsgBox "残念、不正解です。もう一度同じ範囲から出題します。"
- [ ] End If
- [ ] Loop

- [ ] MsgBox "ゲームオーバーです。最終得点は" & score & "点でした。お疲れ様でした。"
- [ ] Range("A1").Value = score
- [ ]
- [ ] End Sub
- [ ]
- [ ] Function CheckAnswer(num As Integer, ans As String) As Boolean
- [ ]
- [ ] Dim factors() As Integer
- [ ] Dim count As Integer
- [ ] Dim i As Integer
- [ ]
- [ ] count = 0
- [ ]
- [ ] Do While num > 1
- [ ]
- [ ] For i = 2 To num
- [ ]
- [ ] If num Mod i = 0 Then
- [ ]
- [ ] count = count + 1
- [ ]
- [ ] ReDim Preserve factors(count)
- [ ]
- [ ] factors(count) = i
- [ ]
- [ ] num = num / i
- [ ]
- [ ] Exit For
- [ ]
- [ ] End If
- [ ]
- [ ] Next i
- [ ]
- [ ] Loop
- [ ]
- [ ] ans = Replace(ans, "=", "")
- [ ]
- [ ] ans = Replace(ans, "*", ",")
- [ ]
- [ ] ans = SortString(ans)
- [ ] CheckAnswer = (ans = Join(factors, ","))
- [ ]
- [ ] End Function
- [ ]
- [ ] Function SortString(str As String) As String
- [ ] Dim arr() As String
- [ ] Dim temp As String
- [ ] Dim i As Integer, j As Integer
- [ ]
- [ ] arr = Split(str, ",")
- [ ]
- [ ] For i = 0 To UBound(arr) - 1
- [ ] For j = i + 1 To UBound(arr)
- [ ]
- [ ] If CInt(arr(i)) > CInt(arr(j)) Then
- [ ]
- [ ] temp = arr(i)
- [ ]
- [ ] arr(i) = arr(j)
- [ ]
- [ ] arr(j) = temp
- [ ]
- [ ] End If
- [ ]
- [ ] Next j
- [ ]
- [ ] Next i
- [ ]
- [ ] SortString = Join(arr, ",")
- [ ]
- [ ] End Function

スポンサーリンク
[返信 1] Re : なんでエラーになるのかわかりません
投稿者 : さんこう     投稿日時 : 2023/09/07(Thu) 08:22:24
>やってみるとsubまたはFunctionが定義されていないとでます

こちらではご提示のエラーにはならず、別のエラーになりました。

ご提示のエラーについては、こちら↓を参考にしてください。

<subまたはFunctionが定義されていません>
https://www.google.com/search?q=sub%E3%81%BE%E3%81%9F%E3%81%AFFunction%E3%81%8C%E5%AE%9A%E7%BE%A9%E3%81%95%E3%82%8C%E3%81%A6%E3%81%84



こちらでは以下の修正で、とりあえずエラーがなくなりましたが、ご希望の動作ではなさそうです。

・変数「range」を別の名前に変更(Rangeオブジェクトと混乱するらしいので)

・変数「factors()」をString型に変更(Integer型ではJoin関数がエラーになるので)

[返信 2] Re : なんでエラーになるのかわかりません
投稿者 : higeru     投稿日時 : 2023/09/07(Thu) 08:36:28
 行頭の "- [ ] " は何なのでしょうか? まさかとは思いますが、実際のコードには入っていませんよね?
 これを取り除いたとしても「SubまたはFunctionが定義されていない」というワーニングは出ませんが、StartGame プロシージャの End Sub 行のひとつ上でコンパイルエラーになって実行できません。これは range という変数名が Range とかぶっているからです。

[返信 3] Re : なんでエラーになるのかわかりません
投稿者 : higeru     投稿日時 : 2023/09/07(Thu) 09:20:09
 さんこうさんが書かれているように factors() は String 型にしないと Join できませんが、VBA はデフォルト 0 オリジンなので Join(0) がじゃまします。
 CheckAnswer 関数の count のインクリメントを 3 行下にずらすか "Option Base 1" を追記すればよいと思います。
 あと、「1 を素因数分解」しろと言われると正解できません。w

[返信 4] Re : なんでエラーになるのかわかりません
投稿者 : 真田幸村     投稿日時 : 2023/09/07(Thu) 14:28:10
みなさん本当にありがとうございました!実行することはできるようになったのですが、全て不正解になってしまいます、『』内のように実行できるようにするにはどのように改善すれば良いのでしょうか。教えていただけると嬉しいです。超がつくほどの初心者なので易しい説明も欲しいです。
 『ボタンを押してゲームをスタートする。1〜20の範囲からランダムで一つ数を選んでプレイヤーがその数の素因数分解の結果を解答として記入し、その回答が正解だったら素因数分解した数を得点として加算して、次の範囲(範囲は20ずつ上がる)で同じことをし、不正解だったら同じ範囲からまた出題して、5回間違ったら終了する。特点はセルA1に表示しておく』


 Sub StartGame()

  Dim score As Integer
   Dim wrong As Integer 
  Dim num As Integer 
   Dim ans As String 
  Dim correct As Boolean 
  Dim r As Integer 
  score = 0 
    wrong = 0
  r = 20  
     Do While wrong < 5 
     num = Int(Rnd() * r) + 1 
     ans = InputBox(num & "の素因数分解の結果を入力してください。例:12=2*2*3") 
     correct = CheckAnswer(num, ans) 
       If correct Then 
        score = score + num 
      r = r + 20 
 MsgBox "正解です!得点は" & score & "点です。次の問題に進みます。" 
 Else 
   wrong = wrong + 1 
 MsgBox "残念、不正解です。もう一度同じ範囲から出題します。" 
  End If
  Loop
   MsgBox "ゲームオーバーです。最終得点は" & score & "点でした。お疲れ様でした。" 
 Range("A1").Value = score     
End Sub


Function CheckAnswer(num As Integer, ans As String) As Boolean
Dim factors() As Integer 
  Dim count As Integer 
 Dim i As Integer     
count = 0 
Do While num > 1    
For i = 2 To num 
 If num Mod i = 0 Then 
 count = count + 1 
  ReDim Preserve factors(count) 
factors(count) = i 
 num = num / i 
Exit For 
End If           
Next i    
 Loop
   ans = Replace(ans, "=", "")   
 ans = Replace(ans, "*", ",") 
 ans = SortString(ans) 
CheckAnswer = (ans = Join(factors, ",")) 
End Function


Function SortString(str As String) As String
Dim arr() As String 
 Dim temp As String 
 Dim i As Integer, j As Integer 
arr = Split(str, ",") 
For i = 0 To UBound(arr) - 1 
For j = i + 1 To UBound(arr) - 1
 If CInt(arr(i)) > CInt(arr(j)) Then 
 temp = arr(i) 
arr(i) = arr(j)
arr(j) = temp
End If
 Next j
 Next i
SortString = Join(arr, ",") 
End Function

[返信 5] Re : なんでエラーになるのかわかりません
投稿者 : さんこう     投稿日時 : 2023/09/07(Thu) 14:38:28
>全て不正解になってしまいます

「Function CheckAnswer(num As Integer, ans As String) As Boolean」での判定が違っているからです。

ここ↓で、「ans」と「Join(factors, ",")」が一致するか見ています。

CheckAnswer = (ans = Join(factors, ","))


すでにご指摘がありましたが、「Join(factors, ",")」がおかしな値になっています。

[返信 6] Re : なんでエラーになるのかわかりません
投稿者 : higeru     投稿日時 : 2023/09/07(Thu) 15:03:23
 すでに書きましたが、

> CheckAnswer 関数の count のインクリメントを 3 行下にずらすか "Option Base 1" を追記すればよいと思います。

「3 行下」という書き方は正確ではないかもで、38 行目を 40 行目の下に移動してください。

 なお "Option Base 1" の方は 58 行目に修正が要るので、ひとまず忘れてください。

[返信 7] Re : なんでエラーになるのかわかりません
投稿者 : さんこう     投稿日時 : 2023/09/07(Thu) 15:24:31
「Function SortString(str As String) As String」もおかしいですね。

並び替えているようですが、条件によっては並びがおかしいです。
(最後の値をみていないようです)

[返信 8] Re : なんでエラーになるのかわかりません
投稿者 : ピロリ     投稿日時 : 2023/09/07(Thu) 16:57:42
皆さんから色々とご指摘が有りますが、下のような感じでどうでしょう?
現状のコードをあまり変更しないようにしたので、少し汚いコード(取り繕った感が半端ない)ですが。
一例として参考になれば・・・
Sub StartGame()
    Dim score As Integer
    Dim wrong As Integer
    Dim num As Integer
    Dim ans As String
    Dim correct As Boolean
    Dim r As Integer
    score = 0
    wrong = 0
    r = 20
    Do While wrong < 5
        num = Int(Rnd() * r) + 1
        ans = InputBox(num & "の素因数分解の結果を入力してください。例:12=2*2*3")
        correct = CheckAnswer(num, ans)
        If correct Then
            score = score + num     '★この時点で num=1 ですが、問題はないですか?
            r = r + 20
            MsgBox "正解です!得点は" & score & "点です。次の問題に進みます。"
        Else
            wrong = wrong + 1
            MsgBox "残念、不正解です。もう一度同じ範囲から出題します。"
        End If
    Loop
    MsgBox "ゲームオーバーです。最終得点は" & score & "点でした。お疲れ様でした。"
    range("A1").Value = score
End Sub

Function CheckAnswer(num As Integer, ans As String) As Boolean
    'Dim factors() As Integer           '★型が不正なので、
    Dim factors() As String             '★文字列型へ修正しました。
    Dim temp As String                  '★追加。
    Dim count As Integer
    Dim i As Integer
    count = 0
    temp = num                          '★追加。(課題の数値を一旦退避)
    If num = 1 Then                     '★追加。(課題が「1」だった場合の対応)
        ReDim Preserve factors(1)       '★追加。
        factors(0) = "1"                '★追加。(これは回答側の「1」を格納)
        factors(1) = "1"                '★追加。(これは課題側の「1」を格納)
    Else                                '★追加。(課題が「1」以外の場合)
        Do While num > 1
            For i = 2 To num
                If num Mod i = 0 Then
                    count = count + 1
                    ReDim Preserve factors(count)
                    'factors(count) = i         '★factors(0)が空になってしまうので、
                    factors(count - 1) = i      '★このように修正しました。
                    num = num / i
                    Exit For
                End If
            Next i
        Loop
        factors(count) = temp           '★追加。(課題の数値を格納)
    End If                              '★追加。
    'ans = Replace(ans, "=", "")        '★課題と回答の1つ目が結合されてしまうので、
    ans = Replace(ans, "=", ",")        '★このように修正しました。
    ans = Replace(ans, "*", ",")
    ans = SortString(ans)
    CheckAnswer = (ans = Join(factors, ","))
End Function

Function SortString(str As String) As String
    Dim arr() As String
    Dim temp As String
    Dim i As Integer, j As Integer
    arr = Split(str, ",")
    For i = 0 To UBound(arr) - 1
        'For j = i + 1 To UBound(arr) - 1       '★最後のデータが処理できないので、
        For j = i + 1 To UBound(arr)            '★このように修正しました。
            If CInt(arr(i)) > CInt(arr(j)) Then
                temp = arr(i)
                arr(i) = arr(j)
                arr(j) = temp
            End If
        Next j
    Next i
    SortString = Join(arr, ",")
End Function

[返信 9] Re : なんでエラーになるのかわかりません
投稿者 : 真田幸村     投稿日時 : 2023/09/07(Thu) 21:27:02
みなさん本当にありがとうございました。
友達との間で素因数分解が流行っているのでどうしても作ってみたかったんです。全くの素人でイライラさせてしまったかもしれませんが本当に感謝しかないです。友達と楽しみます!ありがとうございました!!

当掲示板について
  • Excel VBA に関する掲示板です。Excel VBA に関する質問や疑問、それに対する解決方法など気軽に投稿してください。
  • 記事内ではHTMLのタグは使用できません。
  • 記事は一度投稿すると修正できません。内容を訂正したい場合は返信で対応してください。
  • Sub〜End Sub、Function〜End Function は自動的にプログラムコードとみなし、枠で囲って見やすくします。
  • Excel VBA とは関係ないことや、他人が不快に思うようなことなど、管理人が適当でないと判断した記事は削除する場合があります。
スポンサーリンク
返信入力フォーム
お 名 前  :
内  容   :

ステータス  :

認証コード  : キャプチャ画像 




( 処理日時 : 2023-10-02 00:37:18 )
タイトルとURLをコピーしました