0
2

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

数独を楽しむためのエクセルマクロと関数

Posted at

はじめに

コロナ自粛でこもっていると数独しますよね。

数独はあまり得意ではないのですが、気がつくとある2パターンのロジックで数字を入れていることが多いようです。この2パターンについては、完全に単純作業の繰り返しで、これはこれで楽しい人もいるのはわかりますが、この2パターンについては自動で解いてしまって、それ以外のちょっと難しいところだけを解くようにしたら、より楽しいのではないかと思いました。

ネットを調べてみると、完全に解いてくれる機能を提供しているページなどもあるようですが、ここでしたいのは問題を解くことではなく、数独を楽しむのをサポートしてくれるツールの作成です。

コードがスパゲッティのようになっています。こうすりゃもっとスッキリするのに!とか改善案をいただけますと幸いです。

数独のルール

3 x 3 のマス目がありこれをブロックと呼ぶことにします。全部で9個のブロックが、3 x 3 で並んでいます。つまり9 x 9のマス目があります。あるブロック内の9マスには、1から9の数字が1つづつ入ります。また縦、横の9マスについても同様、1から9の数字が1つづつ入ります。

方針

3つ作りたいと思います。

  1. パターン1を解決する関数を作成
  2. パターン2を解決する関数を作成
  3. ヒント情報を表示するマクロを作成

パターン1

「あるブロック内の、あるマス以外に、ある数字が入り得ない場合、その数字が入る」。以下の例だと、緑色のマスには5が入ります。同じブロック内お他のマスには5が入り得ないからです。
image.png

パターン2

「あるマス目に着目した時に、そのマス目が属するブロック内、縦の列、横の列、にある数字以外が全て登場する場合、そのマス目にはその数字が入る」。以下の例だと、青色のマスには9が入ります。
image.png

ヒント情報

各数字ごとに、その数字が入りうるマス目と、入り得ないマス目が表示されるとヒントになると思います。

制約

作成を容易にするため、エクセルシートのA1のセルを左上にして、数独の問題を置くことにします(A1からI9のセルレンジ)。

パターン1を解くためのエクセル関数 nump1()

引数を2つとります。数独の問題の中のセルの番地、数独の問題全体です。そのセルに、ある値しか入らないことが、パターン1のロジックでわかる場合に、その数字を返すようにします。数独の問題全体を引数にするのは、更新があった場合に確実に自動的に再計算させるためです。エクセルではセルの内容を書き換えると、そのセルを参照している関数の再計算が実施されます。このとき、明示的に参照していないと、再計算が実施されないようです。

関数名は数独の別名のナンプレからnump1としました。

'作者 @yoho at Qiita
'Cellは調査対象となる単独のセル
'Boxはこのセルが含まれるBox
'A1からI9に数独の9 x 9のデータがある必要がある。

Public Function nump1(Cell As Range, XXX As Range) As String

Dim sR As Integer
Dim sC As Integer
Dim c As Integer
Dim r As Integer
Dim ans As String

'返り値を一時的にしまう変数
ans = ""

'指定セルに値があるときは何もしない
If Len(Cell.Text) = 1 Then
    GoTo LastPoint
End If

'指定セルが含まれるボックスの左上のセルの行と列を計算で求める
sR = Int((Cell.Row - 1) / 3) * 3 + 1 '行
sC = Int((Cell.Column - 1) / 3) * 3 + 1 '列

'1から9まで順番に、指定セルで確定できるか調べる(その数字がbox内の他の全てのセルに入り得なければ、このセルで確定)
For i = 1 To 9
    'iがbox内にあるときはその数字は調べない
    For c = sC To sC + 2
        For r = sR To sR + 2
            If Cells(r, c).Value = i Then GoTo NEXTNUMBER
        Next r
    Next c
    
    For c = sC To sC + 2
        For r = sR To sR + 2
             If Cell.Row = r And Cell.Column = c Then GoTo Continue '調査対象のセルは飛ばす
             
             If Len(Cells(r, c).Text) = 0 Then
                 flag = 0
                 For A = 1 To 9
                     If Cells(r, A) = i Then flag = 1
                 Next A
                 For B = 1 To 9
                     If Cells(B, c) = i Then flag = 1
                 Next B
                 If flag = 0 Then GoTo NEXTNUMBER 'その数字はボックス内の他のセルに入りうる。つまり、標的のセルに入るか確定できない
            End If
Continue:
        Next r
    Next c
        
    'その数字iが入るはずだが、そもそもどこかで間違えているかもしれないのでチェックする。
    'iはbox内にないことは確認済みなので縦横のチェックをする
    flag2 = 0
    For T = 1 To 9
                If Cells(Cell.Row, T) = i Then flag2 = 1
    Next T
    For Y = 1 To 9
                If Cells(Y, Cell.Column) = i Then flag2 = 1
    Next Y
    
    If flag2 = 0 Then
        ans = str(i)
    Else
        ans = "X" & str(i)
    End If
    
    GoTo LastPoint

NEXTNUMBER:
Next i

LastPoint:
nump1 = ans
End Function

処理の概要です。

  1. 指定セルに値があるときは、空白文字列を返す。
  2. 第一引数で指定したセルが含まれるボックスの行番号と列番号を計算で求める。
  3. 数字1から9まで、数字iについて順番に以下を調べる。
    3-1. ボックス内に数字iがあるかどうか。あれば次の数字へ。
    3-2. ボックス内の9個のセルXについて調べる。
    3-2-1. 指定セルは飛ばす。
    3-2-2. セルXにすでに数字が入っていれば次のセルへ
    3-2-3. セルXと同じ行を調べて、数字iがあるか調べる。
    3-2-4. セルXと同じ列を調べて、数字iがあるか調べる。
    3-2-5. 上2つのチェックで、数字iがどちらにもなければ、セルXには数字iが入りうる。次の数字へ。
    3-3. 指定セル以外のボックス内の8つのセルについて、数字iが入り得ない。つまり指定セルに、数字iが入る。
    3-4. 念の為、数字iを入れて良いかチェック。OKなら数字iを返す。

パターン2を解くためのエクセル関数 nump2()

指定したセルについて、そのセルが含まれるボックス内、同じ行、同じ列、について、1から9までのうち、まだ使われていない数字を返します。

'作者 @yoho at Qiita
Public Function nump2(Cell As Range, XXX As Range) As String

    Dim A(10) As Boolean
    Dim sR As Integer
    Dim sC As Integer
    Dim c As Integer
    Dim r As Integer
    Dim ans As String
    Dim number As String
    
    If Len(Cell.Text) = 1 Then
        ans = ""
        GoTo LastPoint
    End If
    
    For i = 1 To 9
        A(i) = True
    Next i
    
    'box内にある数字をFalseに
    sR = Int((Cell.Row - 1) / 3) * 3 + 1 '
    sC = Int((Cell.Column - 1) / 3) * 3 + 1
    
    For c = sC To sC + 2
        For r = sR To sR + 2
            number = Cells(r, c).Text
            If Len(number) = 1 Then
                indint = CInt(number)
                A(indint) = Flase
            End If
        Next r
    Next c
    
    '同じ行内の数字をFalseに
    For c = 1 To 9
        number = Cells(Cell.Row, c).Text
        If Len(number) = 1 Then
            indint = CInt(number)
            A(indint) = Flase
        End If
    Next c
    
    '同じ列内の数字をFalseに
    For c = 1 To 9
        number = Cells(c, Cell.Column).Text
        If Len(number) = 1 Then
            indint = CInt(number)
            A(indint) = Flase
        End If
    Next c
    

    For c = 1 To 9
        If (A(c) = True) Then ans = ans & c
    Next
    
LastPoint:
    nump2 = ans
End Function


処理の概要です。

  1. bool値の配列を準備して、初期値をTrueにする。
  2. 第一引数で指定したセルが含まれるボックスの行番号と列番号を計算で求める。
  3. 同じボックス内に含まれる文字を数値に変換。bool配列のそのindexに対応する値をFalseに。
  4. 同じ行内について同様に処理
  5. 同じ列内について同様に処理
  6. 値がTrueであるindexについて、連結して返す。例えば1258。

使用例

http://www.sudokugame.org/ にあった上級問題です。
A1からI9に数独の問題を入れます。
K1のセルに=nump1(A1,$A$1:$I$9)と入力して、K1からS9の範囲にコピーペーストします。
U1のセルに=nump2(A1,$A$1:$I$9)と入力して、U1からAC9の範囲にコピーペーストします。

image.png

パターン1で1と7を入れられる場所が表示されています。パターン2で入れられる場所はまだありません。

数独支援用マクロ

関数nump1とnump2でパターン1とパターン2については解決できるようになりました。言い換えるとパターン1とパターン2で解決できない難しい問題が残ってしまうことになりました。数独初級レベルの私としては、何をどうしたら残った問題を解決できるのか、よくわからないところではありますが、各数字について、入り得ないマス目の背景をグレーにするマクロを作成することにしました。

A1からI9に数独の問題がある場合に有効です。

Sub nump()
'作者 @yoho at Qiita
    Dim num As Integer
    Dim boxRange As Range
    Dim offsetX() As Variant
    Dim offsetY() As Variant
    Dim boxR As Integer
    Dim boxC As Integer
     
    offsetX = Array(0, 10, 20, 0, 10, 20, 0, 10, 20)
    offsetY = Array(11, 11, 11, 22, 22, 22, 33, 33, 33)
    
    For num = 1 To 9
        For Row = 1 To 9
           For Column = 1 To 9
                'Cells(Row,Column)に数字が入っていれば塗る
                If Len(Cells(Row, Column).Text) = 1 Then GoTo PAINT

                '同じ行にnumがあれば塗る
                For x = 1 To 9
                    If Cells(Row, x) = num Then GoTo PAINT
                Next x

                '同じ列にnumがあれば塗る
                For Y = 1 To 9
                    If Cells(Y, Column) = num Then GoTo PAINT
                Next Y

                '同じboxにnumがあれば塗る
                'boxの左上の番地を計算boxRange
                boxR = Int((Row - 1) / 3) * 3 + 1
                boxC = Int((Column - 1) / 3) * 3 + 1
                For rrr = boxR To boxR + 2
                    For ccc = boxC To boxC + 2
                        If Cells(rrr, ccc) = num Then GoTo PAINT
                    Next ccc
                Next rrr
                
                'それ以外は塗らない
                GoTo DONTPAINT
               
PAINT:
                Cells(Row + offsetY(num - 1), Column + offsetX(num - 1)).Interior.ColorIndex = 15
DONTPAINT:
                
            Next Column
        Next Row
    Next num
    
End Sub

処理の概要です。

  1. 数字ごとに、エクセルシートのどこを塗って欲しいかをしているするための配列を2つ用意。行方向と列方向それぞれに、どこを起点に描画するかです。
  2. 1から9の数字numについて処理
  3. 数独の問題中の各セルXについて処理。以下のどれかに当てはまれば色を塗って次のセルへ。
    3-1. セルXにすでに数字が入っていれば塗る処理を実行
    3-2. 同じ行に、numがあれば塗る処理を実行
    3-3. 同じ列に、numがあれば塗る処理を実行
    3-4. 同じボックス内に、numがあれば塗る処理を実行
  4. 色を塗る処理: 数字ごとに、シート中の異なる部分を指定して、背景をグレーに。

とある問題について、このマクロを実行した時の様子です。枠と数字は別につけました。

image.png

例えば、このグレーに塗ったやつに、さらに色をつけていきます。普通に解くよりも難しい問題を解くロジックに集中できるのではないでしょうか?
image.png

終わりに

数独の単純作業で解けるところは解いてしまい、そうでないところだけを残すことができるようになりました。難しいところだけを解くことで、数独のレベルアップがしやすい状況を作ることができたのではないかと思います。

今しばらくコロナ自粛で巣ごもりしながら、数独のレベルアップを図りたいと思います。
皆さんも、数独で巣ごもりしましょう!

0
2
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
2

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?