Dim iz(400) As Byte, jz(400) As Byte, gk(100) As Byte
Dim mah(20, 20) As Byte, tyouhukuhantei(400) As Byte, hs As Byte, dhs(9, 9, 9) As Byte, dhs1(9, 9, 9) As Byte, cnn(9, 9) As Byte
Dim cn As Byte
Dim kz As Integer
Dim ks As Byte
Dim cmah(8, 8) As Byte
Private Sub CommandButton1_Click()
    f
    Dim i As Byte
    Dim j As Byte
    Worksheets("Sheet1").Cells(2, 1).Select
    kz = 0
    ks = 0
    Dim sz As Integer
    sz = 21600
    Do While 1
        cn = 0
        dainyuu
        mondaikaiseki
        sakusei (0)
        If cn = 0 Then
            Cells(3 + Int(kz / 40), 1 + (kz Mod 40)) = "�I"
            hyouji2
            ks = ks + 1
        End If
        If cn = 1 Then Cells(3 + Int(kz / 40), 1 + (kz Mod 40)) = "��"
        If cn = 2 Then
            Cells(3 + Int(kz / 40), 1 + (kz Mod 40)) = "�~"
            hyouji2
            ks = ks + 1
        End If
        kz = kz + 1
        If kz = sz Then Exit Do
    Loop
        
owari:
End Sub
Sub hyouji2()
    Dim i As Byte, j As Byte
    For i = 0 To 8
        For j = 0 To 8
            If cmah(i, j) > 0 Then
                Cells(3 + 10 * Int(ks / 8) + i, 44 + 10 * (ks Mod 8) + j) = cmah(i, j)
            End If
        Next
    Next
End Sub
Sub dainyuu()
    Dim i As Byte, j As Byte
    
    For i = 0 To 8
        For j = 0 To 8
            mah(i, j) = Cells(313 + i + 10 * Int(kz / 40), 2 + j + 10 * (kz Mod 40))
            cmah(i, j) = Cells(313 + i + 10 * Int(kz / 40), 2 + j + 10 * (kz Mod 40))
        Next
    Next
    For i = 0 To 8
        For j = 0 To 8
            If mah(i, j) < 1 Then mah(i, j) = 0
            If cmah(i, j) < 1 Then cmah(i, j) = 0
            cnn(i, j) = 0
        Next
    Next

End Sub

Sub mondaikaiseki()

    Dim i As Byte, j As Byte, i1 As Byte, i2 As Byte, i3 As Byte, i4 As Byte, i5 As Byte, i6 As Byte
    For i = hg To 80
        gk(i) = 0
    Next
    For i1 = 0 To 8
        For i2 = 0 To 8
            If mah(i1, i2) = 0 Then
                For i3 = 0 To 8
                    dhs(i1, i2, i3) = 0
                Next
                For i3 = 0 To 8
                    If i2 <> i3 And mah(i1, i3) > 0 Then dhs(i1, i2, mah(i1, i3) - 1) = 1
                Next
                For i3 = 0 To 8
                    If i1 <> i3 And mah(i3, i2) > 0 Then dhs(i1, i2, mah(i3, i2) - 1) = 1
                Next
                i1s = Int(i1 / 3)
                i2s = Int(i2 / 3)
                For i3 = 0 To 2
                    For i4 = 0 To 2
                        If 3 * i1s + i3 <> i1 And 3 * i2s + i4 <> i2 And mah(3 * i1s + i3, 3 * i2s + i4) > 0 Then dhs(i1, i2, mah(3 * i1s + i3, 3 * i2s + i4) - 1) = 1
                    Next
                Next
                For i3 = 0 To 8
                    If dhs(i1, i2, i3) = 0 Then
                        w = cnn(i1, i2)
                        dhs1(i1, i2, w) = i3 + 1
                        cnn(i1, i2) = cnn(i1, i2) + 1
                    End If
                Next
            End If
        Next
    Next
    bangousakusei
    
End Sub
Sub bangousakusei()
    Dim i1 As Byte, i2 As Byte, i3 As Byte
    g = 0
    For i = 1 To 9
        For j = 0 To 8
            For k = 0 To 8
                If cnn(j, k) = i Then
                    iz(g) = j
                    jz(g) = k
                    g = g + 1
                End If
            Next
        Next
    Next
    hs = g
End Sub

Sub sakusei(g As Byte)
    If cn = 2 Then Exit Sub
    Dim i As Byte, j As Byte, k As Byte, l As Byte, hh As Byte, wa As Byte
    j = jz(g)
    i = iz(g)
    
    mx = cnn(i, j)
    Rnd
    Rnd
    Rnd
    kk = Int(Rnd * mx)
    For k = 1 To mx
        mah(i, j) = dhs1(i, j, kk)
        'Cells(14 + i, 2 + j) = mah(i, j)
        For l = 0 To 8
            If l <> j And mah(i, l) > 0 Then If mah(i, l) = mah(i, j) Then GoTo owari
        Next
        For l = 0 To 8
            If l <> i And mah(l, j) > 0 Then If mah(l, j) = mah(i, j) Then GoTo owari
        Next
        ia = i Mod 3
        ja = j Mod 3
        For l = 0 To 2
            For m = 0 To 2
                If (j - ja + m) <> j And (i - ia + l) <> i And mah(i - ia + l, j - ja + m) > 0 Then
                    If mah(i, j) = mah(i - ia + l, j - ja + m) Then GoTo owari
                End If
            Next
        Next
        
        If g + 1 < hs Then
            sakusei (g + 1)
            If cn = 2 Then Exit Sub
        Else
            cn = cn + 1
            If cn = 2 Then Exit Sub
        End If
owari:
        kk = (kk + 1) Mod mx
        If cn = 2 Then Exit Sub
    Next
    mah(i, j) = 0
    

End Sub
Sub hyouji()
    Dim i As Byte, j As Byte
    
    For i = 0 To 8
        For j = 0 To 8
            Cells(i + 14, j + 2 + 10 * (cn - 1)) = mah(i, j)
        Next
    Next

End Sub
Private Sub CommandButton2_Click()

'    Rows("4:12").Select
'    Selection.ClearContents
    
    Rows("1:5000").Select
    Selection.ClearContents
    
    Cells(2, 1).Select

End Sub
Sub f()

'    Rows("4:12").Select
'    Selection.ClearContents
    
    Rows("1:33").Select
    Selection.ClearContents
    
    Cells(2, 1).Select

End Sub