Excelで本格ナンプレを作ろう！〜自動生成・難易度別問題・正解チェックまで完全網羅〜

この記事ではマクロ（VBA）を使用します。
マクロ初挑戦の方はこちらの記事からスタートすることをお勧めします。
Excelのマクロ初期設定ガイド

---

---

---

🧱準備編：盤面の作成

まず最初のステップは「正解の盤面＝完成されたナンプレ」を作ること！

ナンプレの正解盤面は以下のようなルールを満たす必要があります：

• 各行に1～9の数字が一度ずつ
• 各列に1～9の数字が一度ずつ
• 各3×3のブロックにも1～9が一度ずつ

…これを手作業でやるなんてムリゲー！
なのでここはジッピーにまかせて、VBAで完全自動生成できるようにしちゃいましょう！

---

🎯正解盤面の表示場所

正解盤面は「回答」シートの B3:J11 に表示されます。
これが元データとなり、後の「問題作成」や「正解チェック」にも使われていきます！

---

💻使ったマクロ（簡易紹介）

盤面を生成するマクロの処理の流れは以下の通り：

1. 空の9×9盤面を用意
2. 各マスにランダムな数字を試して入れていく
3. 条件を満たすなら確定、ダメなら戻ってやり直す（バックトラッキング）

この仕組みを組み込んだマクロが、こちら👇

' モジュールに貼り付けてね！
Sub ナンプレ正解盤面を生成()
    Dim board(1 To 9, 1 To 9) As Integer
    Dim ws As Worksheet
    Set ws = Worksheets("回答") ' シート名に合わせて調整してね

    If FillSudoku(board) Then
        Dim r As Integer, c As Integer
        For r = 1 To 9
            For c = 1 To 9
                ws.Cells(r + 2, c + 1).Value = board(r, c)
            Next c
        Next r
        MsgBox "新しい問題が生成されました。", vbInformation, "ナンプレ自動生成"
    Else
        MsgBox "盤面の生成に失敗しました", vbExclamation
    End If
End Sub

Function FillSudoku(board() As Integer) As Boolean
    Dim r As Integer, c As Integer, nums(1 To 9) As Integer, i As Integer
    
    For r = 1 To 9
        For c = 1 To 9
            If board(r, c) = 0 Then
                Call ShuffleArray(nums)
                For i = 1 To 9
                    If IsValid(board, r, c, nums(i)) Then
                        board(r, c) = nums(i)
                        If FillSudoku(board) Then
                            FillSudoku = True
                            Exit Function
                        End If
                        board(r, c) = 0
                    End If
                Next i
                FillSudoku = False
                Exit Function
            End If
        Next c
    Next r
    FillSudoku = True
End Function

Function IsValid(board() As Integer, row As Integer, col As Integer, num As Integer) As Boolean
    Dim i As Integer, j As Integer
    For i = 1 To 9
        If board(row, i) = num Or board(i, col) = num Then Exit Function
    Next i
    
    Dim startRow As Integer, startCol As Integer
    startRow = ((row - 1) \ 3) * 3 + 1
    startCol = ((col - 1) \ 3) * 3 + 1
    For i = 0 To 2
        For j = 0 To 2
            If board(startRow + i, startCol + j) = num Then Exit Function
        Next j
    Next i
    
    IsValid = True
End Function

Sub ShuffleArray(arr() As Integer)
    Dim i As Integer, j As Integer, temp As Integer
    ' 1?9の数値をセット
    For i = 1 To 9
        arr(i) = i
    Next i
    ' フィッシャー?イェーツシャッフル
    For i = 9 To 2 Step -1
        j = Int(Rnd() * i) + 1
        temp = arr(i)
        arr(i) = arr(j)
        arr(j) = temp
    Next i
End Sub

実際にこのボタンを押してみると…
パッ！ と9×9の盤面が完成！
しかも毎回違うパターンが出るので、何度も楽しめる設計になっています✨

---

🧠ジッピーの小ネタ解説

裏では「バックトラッキング」っていう再帰的な処理が動いてるんだよ！
完成するまで一瞬に見えて、実はかなり頭使ってるやつ（笑）

---

---

---

🧱問題編：難易度別出題

---

🎯難易度によって空欄数を変える！

ナンプレの難易度は、実は「ロジックの深さ」で決まるんですが、
今回はシンプルに「空欄の数（虫食い数）」で3段階に分けました！

難易度	空欄数の目安	わかりやすい特徴
初級	約35マス	数字が多くヒント豊富
中級	約45マス	解き応えあり
上級	約55マス	気を抜くと詰まる…！

---

🛠使ったVBAマクロ（虫食い＆コピー）

以下のマクロでは、回答シートの盤面から虫食い加工をして
「問題」シートのB3:J11にコピーしてくれます。

Sub ナンプレ問題生成(難易度 As String)
    Dim 元シート As Worksheet, 問題シート As Worksheet
    Set 元シート = Worksheets("回答")
    Set 問題シート = Worksheets("問題")
    
    Dim row As Long, col As Long
    Dim 値配列(1 To 9, 1 To 9) As Variant
    Dim マスリスト As Collection
    Set マスリスト = New Collection

    ' 正解盤面を読み込み
    For row = 1 To 9
        For col = 1 To 9
            値配列(row, col) = 元シート.Cells(row + 2, col + 1).Value
        Next col
    Next row

    ' 全マスをリスト化
    For row = 1 To 9
        For col = 1 To 9
            マスリスト.Add Array(row, col)
        Next col
    Next row

    ' 難易度別の空欄数
    Dim 消す数 As Long
    Select Case 難易度
        Case "初級": 消す数 = 35
        Case "中級": 消す数 = 45
        Case "上級": 消す数 = 55
        Case Else: 消す数 = 40
    End Select

    ' ランダムに空欄化
    Randomize
    Dim i As Long
    For i = 1 To 消す数
        If マスリスト.Count = 0 Then Exit For
        Dim idx As Long: idx = Int(Rnd() * マスリスト.Count) + 1
        Dim pos: pos = マスリスト(idx)
        値配列(pos(0), pos(1)) = ""
        マスリスト.Remove idx
    Next i

    ' 結果を問題シートに反映
    For row = 1 To 9
        For col = 1 To 9
            問題シート.Cells(row + 2, col + 1).Value = 値配列(row, col)
        Next col
    Next row
End Sub

---

📦ボタン用の呼び出しマクロ

ボタンにはこれを使ってね👇

Sub 初級問題()
    Call ナンプレ問題生成("初級")
End Sub

Sub 中級問題()
    Call ナンプレ問題生成("中級")
End Sub

Sub 上級問題()
    Call ナンプレ問題生成("上級")
End Sub

---

🧠ジッピーの小ネタ解説

虫食いの位置はランダムに選ばれてるから、
同じ難易度でも毎回違う問題が出るんだよ！
つまり、エンドレスナンプレ生成可能🔥

---

---

🛡保護編：入力ミス防止＆チート防止対策

---

🎯やりたいこと

• 「問題」シートの B3:J11 を対象に
• 空欄セルだけロック解除（= 入力可）
• 数字が入ってるセルはロック（= 編集不可）
• その上でシート全体を保護

---

💻VBAマクロ：保護処理（空欄だけ入力可）

Sub 空欄セルだけロック解除して保護()
    Dim ws As Worksheet
    Set ws = Worksheets("問題")
    
    ' 一旦すべてロック
    ws.Cells.Locked = True

    Dim r As Long, c As Long
    For r = 3 To 11
        For c = 2 To 10
            With ws.Cells(r, c)
                If .Value = "" Then
                    .Locked = False ' 空白セルだけロック解除
                Else
                    .Locked = True  ' ヒント数字は編集不可
                End If
            End With
        Next c
    Next r
    
    ' シート保護（ユーザー操作を許す設定）
    ws.Protect Password:="", UserInterfaceOnly:=True
End Sub

---

📎マクロの組み込み先

先ほどの問題マクロを書き替えてね👇

Sub 初級問題()
    Call ナンプレ問題生成("初級")
    Call 空欄セルだけロック解除して保護
End Sub

Sub 中級問題()
    Call ナンプレ問題生成("中級")
    Call 空欄セルだけロック解除して保護
End Sub

Sub 上級問題()
    Call ナンプレ問題生成("上級")
    Call 空欄セルだけロック解除して保護
End Sub

---

🔧補足：起動時にも保護を効かせたいなら…

「ThisWorkbook」に↓を入れると、ブックを開くたびに保護が自動で効くようになるよ！

Private Sub Workbook_Open()
    Worksheets("問題").Protect Password:="", UserInterfaceOnly:=True
End Sub

---

🧠ジッピーの小ネタ解説

シート保護って見た目は地味だけど、
ゲーム系VBAではめちゃくちゃ重要なセキュリティ要素なんだよね〜
これでズルもミスも防げるし、ストレスフリーで遊べるぞ！

---

---

🧱チェック編：自動で正解判定

---

🎯やりたいこと

• 「問題」シートの B3:J11 に入力された数字を
• 「回答」シートの B3:J11 と照らし合わせ
• 間違っていたら：セルを赤く塗る＋メッセージ
• 全て合っていたら：**「正解です！」**のメッセージ

---

💻チェックボタン用マクロ（答え判定）

Sub 答えチェック()
    Dim ws問 As Worksheet, ws答 As Worksheet
    Set ws問 = Worksheets("問題")
    Set ws答 = Worksheets("回答")
    
    Dim r As Long, c As Long
    Dim 間違いあり As Boolean: 間違いあり = False
    
    ' チェック開始
    For r = 3 To 11
        For c = 2 To 10
            With ws問.Cells(r, c)
                If .Value <> "" Then
                    If .Value <> ws答.Cells(r, c).Value Then
                        .Interior.Color = RGB(255, 200, 200) ' 間違い：赤く塗る
                        間違いあり = True
                    Else
                        .Interior.ColorIndex = xlNone ' 正解：色戻す
                    End If
                End If
            End With
        Next c
    Next r
    
    ' 判定メッセージ
    If 間違いあり Then
        MsgBox "間違いがあります。赤いマスを見直してね！", vbExclamation, "チェック結果"
    Else
        MsgBox "正解です！お見事！", vbInformation, "チェック結果"
    End If
End Sub

---

✅補足ポイント

• 空欄は無視（何も入ってないマスはチェック対象外）
• 正解のマスは塗りを戻してクリーンに
• 間違ってたら目立つやさしい赤で塗って視覚的にサポート！

---

🧠ジッピーの小ネタ解説

実はこの機能、ユーザー体験的にも超重要で、
成功体験と「直せる失敗体験」が両方味わえる設計なんだ✨
だからただのゲームじゃなくて、**“ナンプレ上達マシン”**にもなってるぞ！

---

---

🧠さて本題：自動チェックはWorksheetモジュール！

---

🎯やりたいことまとめ

• 問題シートのB3:J11がすべて埋まったら
• 自動的に「答えチェック」が走る
• 間違いがあれば赤く塗って警告
• 完璧だったら「🎉正解です！」とお祝い！

---

🧩コード（問題シートのWorksheetモジュールに）

1. VBEで「Sheet1 (問題)」をダブルクリック
2. 以下を貼り付け！

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 範囲外は無視
    If Intersect(Target, Range("B3:J11")) Is Nothing Then Exit Sub

    Dim r As Long, c As Long
    Dim 完成 As Boolean: 完成 = True

    ' 全マス埋まったかチェック
    For r = 3 To 11
        For c = 2 To 10
            If Cells(r, c).Value = "" Then
                完成 = False
                Exit For
            End If
        Next c
        If Not 完成 Then Exit For
    Next r

    If 完成 Then
        ' 自動チェック開始
        Dim ws答 As Worksheet
        Set ws答 = Worksheets("回答")
        Dim 正解 As Boolean: 正解 = True

        For r = 3 To 11
            For c = 2 To 10
                With Cells(r, c)
                    If .Value <> ws答.Cells(r, c).Value Then
                        .Interior.Color = RGB(255, 200, 200)
                        正解 = False
                    Else
                        .Interior.ColorIndex = xlNone
                    End If
                End With
            Next c
        Next r

        If 正解 Then
            MsgBox "正解です！すべてのマスが完璧に揃っています！", vbInformation, "ナンプレ判定"
        Else
            MsgBox "間違いがあります。赤くなったマスを見直してみてね。", vbExclamation, "ナンプレ判定"
        End If
    End If
End Sub

---

✅補足ワザ

• イベントは保護状態でも動く！（UserInterfaceOnly:=Trueを使ってるからOK）
• 答えチェックボタンを補助的に残してもアリ
  • 「途中で確認したい人」用

---

🧠ジッピーの小ネタ解説

この自動判定は、ゲームっぽさもアップするし、
子どもから大人まで「わかった！終わった！」って気持ちよく締められるのがポイント✨
エクセルゲームでは「ごほうび表示」は超重要なんだ！

---

---

---

🧹便利機能：問題クリアボタン

---

💻マクロ：問題クリア（値と塗りつぶしのリセット）

Sub 問題クリア()
    Dim ws As Worksheet
    Set ws = Worksheets("問題")
    
    Dim r As Long, c As Long
    For r = 3 To 11
        For c = 2 To 10
            With ws.Cells(r, c)
                .ClearContents           ' 値をクリア
                .Interior.ColorIndex = xlNone  ' 色を元に戻す
            End With
        Next c
    Next r
End Sub

---

✅補足

• 書式（罫線やフォント）はそのまま残るよ！
• ゲームの「ニューゲームボタン」的な役割！
• 「答えチェック」で塗られた赤も一掃される✨

---

🧠ジッピーの小ネタ解説

実は ClearContents と Interior.ColorIndex = xlNone をセットにすることで、
「やり直しが怖くない」安心ナンプレに仕上がってるんだ✨
どんどん挑戦できるって大事！

---

---

---

🔍与えられたナンプレ（上級問題）

							5
	8			7		3
		2		4		1	9
6		1						7
			6		5
	9					6
9		3			6			1
5				7		2
4		5		2				3

---

🧩ジッピー、全力で解いてみるよ！！

---

🛑エラーの可能性

• 盤面に重複してる数字がある
• ヒントが解けない組み合わせになっている
• OCR時や目視入力時にミスが混入したかも

---

🧠ここからできる対応

1. もう一度盤面を見直して、
   • 入力ミスや、明らかに矛盾する箇所がないか確認
2. もしくは「ジッピー、これならどうよ！」と
   • 別の上級問題をアップしてくれてもOK！

---

---

🏁ジッピーの締めのごあいさつ

今回は
📌 ナンプレ正解盤面の自動生成
📌 難易度ごとの虫食い問題作成
📌 入力制限とチェック機能
📌 自動判定＆リセットボタンまで！

---

おわりに