ダウンロード

自動入力「単一候補」を回答表に自動入力します。(単純な初級レベルは最終回答可)

仕様

候補が1つに確定」数字を「回答表」に入力します。

候補入力:「調査する数字」を可能な限りすべて入力します。
  数字を入力すると状況が変わり、新たに再計算されるため、入力できる候補が変化。
  よって、入力を繰り返し、その数字を置ける候補セルが無くなるまで繰り返します。

全自動入力:数字を1~9に変化させ、それぞれの数字で人るに絞られた候補セルに自動入力して。
  入力するたびに状況が変化し候補セルも変わっていくので、単一候補セルが無くなるまで繰り返します。


下図一番上のコンボボックスは例題選択用

「例題」シートに初級20問、中級6問、上級1問を用意しています。
プルダウンメニューから選択すれば、自動的に例題が自動転記
(直に入力、または他の例題を貼り付けても可-書式は壊さない様に!

解答成功率  初級:14/20、中級:3/6、上級 0/1

全問正解しようとすると、やはり、頭脳的な技が必要になります。

次の機会に挑戦!!


VBAコード

Option Explicit



Private Sub cmd全候補入力_Click()

    Dim n As Integer
    Dim blRc As Boolean
    
    Do
        blRc = False
        For n = 1 To 9
            Range("NO").Value = n
            blRc = blRc Or 候補入力(n)
        Next n
    Loop While blRc  '入力できる数字が有った場合は継続

End Sub

Private Sub cmd候補入力_Click()

    候補入力 Range("NO").Value
    
End Sub

Private Function 候補入力(No As Integer) As Boolean
'
' 唯一候補を全て入力
'
' 戻り値:True - 入力有り  False:無し

    Dim n As Integer    '入力する数字
    Dim r As Integer, c As Integer '行列番号
    Dim blRc As Boolean '候補有無 True:入力できる数字が有った!
    
    候補入力 = False

    Do
        
        blRc = False
        
        '単一候補表を調べて、有ったら回答表に入力
        
        With Range("候補")
            For r = 1 To .Rows.Count
                For c = 1 To .Columns.Count
                    If .Cells(r, c).Value <> "" Then
                        Range("数独").Cells(r, c).Value = No
                        候補入力 = True
                        blRc = True
                    End If
                Next c
            Next r
        End With
        
    Loop While blRc  '入力できる数字が有った場合は再度調査


End Function




Private Sub cmbSample_Click()
'
' 例題選択
'
    Dim r As Integer  'サンプル行番号
    With cmbSample
        r = .List(.ListIndex, 1) - 1
        Range("数独") = Sheets("例題").Range("SAMPLES").Offset(r, 0).Range("a1:i9").Value
    
    End With

End Sub

標準モジュール

Option Explicit

Function IsValidNum(Arr) As Integer
    
    Dim n As Integer
    Dim Nums, tmp
    Dim D(1 To 9) As Integer
    
    IsValidNum = 0
    
    Nums = Arr
    For Each tmp In Nums
        
        If Not IsEmpty(tmp) Then
            If Not IsNumeric(tmp) Then Exit Function    '非数値
            If tmp < 1 Or tmp > 9 Then Exit Function        '範囲外数値
            D(tmp) = D(tmp) + 1
        End If
        
    Next
    
    For n = 1 To 9
        If D(n) > 1 Then Exit Function  '重複
    Next
    
    IsValidNum = 1
    
End Function

トップページへ

← 前のページへ

テンプレートのダウンロード