我在vb上写了一个计算数独的程序
但是按键按下后程序卡死，并且不执行按键后的内容
若将最后一段删去后，虽功能无法实现，但程序正常运行
请各位大大帮忙解惑
ps:算法可能不是很好，如果可以最好帮我优化下算法


附上程序：
（初次尝试，程序有点乱）




Dim a(81, 40, 3) As Integer



Private Sub C_Click()

Dim t1, t2 As Integer
Dim k1, k2, k3, k4 As Integer
Dim p, q As Integer
Dim n, o, r As Integer
Dim m As Integer
Dim t As Integer
Dim j As Integer
Dim t3 As Integer
Dim mm As Integer
Dim sd As Long
mm = 0
j = 0
m = 0
d = 0
'sd = Text2.Text
'For t2 = 0 To 80 'read the number
'  a(t2, 0, 0) = sd Mod 10
'  sd = Int(sd / 10)
'Next t2
'
'For t2 = 0 To 80 'display the number
'   Text1(t2).Text = a(t2, 0, 0)
'Next t2




For t2 = 0 To 80 'read and deal with the number
  a(t2, 0, m) = Text1(t2).Text
  If a(t2, 0, m) > 9 Then a(t2, 0, m) = a(t2, 0, m) / 10
  If a(t2, 0, m) <= 0 Then a(t2, 0, m) = -(2 ^ 9 - 1)
Next t2


For t2 = 0 To 80 'display
Text1(t2).Text = a(t2, 0, 0)
Next t2



kkk: '出错后，重新读取最后一次对的存档
If d = 1 Then

For t1 = 0 To 80
  a(t1, 0, 0) = a(t1, j, 0)
Next t1
For t2 = 0 To 80
  If a(t2, 0, 0) < 0 Then
    For p = 0 To 8
      If -a(t2, 0, 0) / 2 ^ p Mod 2 = 1 Then
        
        a(t2, 0, 0) = a(t2, 0, 0) + 2 ^ p
        For t1 = 0 To 80
           a(t1, j, 0) = a(t1, 0, 0)
        Next t1
        a(t2, 0, 0) = p + 1
      End If
      GoTo eee
    Next p
  End If
Next t2
End If
eee:

d = 0’进入读档程序标志
t = 1’再一次运算中，若改变过表格中数据，则t=1，若无，t=0
Do


jin: '假设数据后跳转位置


t = 0

For m = 0 To 2’用表格中数据推理（无假设）

For k1 = 0 To 80 Step 9’将表格中数据以同列，同行，同一个小九宫不能有相同数进行筛选
  For k2 = 0 To 8
    If a(k1 + k2, 0, m) > 0 Then
      For k3 = 0 To 8
        If a(k1 + k3, 0, m) < 0 And Int((-a(k1 + k3, 0, m) / (2 ^ (a(k1 + k2, 0, m) - 1)))) Mod 2 = 1 Then
          a(k1 + k3, 0, m) = a(k1 + k3, 0, m) + 2 ^ (a(k1 + k2, 0, m) - 1)
          t = 1
        End If
      Next k3
    End If
  Next k2
Next k1


For k1 = 0 To 80 Step 9’若在一行，一列，或一个九宫中有一个数尽在一个格中有可能，则确定这个数
  For k2 = 0 To 8
    p = 0
    For k3 = 0 To 8
      If (a(k1 + k3, 0, m) > 0 And a(k1 + k3, 0, m) <> k2 + 1) Or (a(k1 + k3, 0, m) < 0 And Int(-a(k1 + k3, 0, m) / 2 ^ (k2)) Mod 2 = 0) Then
        p = p + 1
      Else
        q = k1 + k3
      End If
    Next k3
    If p = 8 Then
      If a(q, 0, m) < 0 Then
        a(q, 0, m) = k2 + 1
        t = 1
      End If
    End If
  Next k2
Next k1


  For t2 = 0 To 80’若某个格中只有一种可能性，则确定该数
    If a(t2, 0, m) < 0 Then
      For p = 0 To 8
        If -a(t2, 0, m) = 2 ^ p Then
          a(t2, 0, m) = p + 1
          t = 1
        End If
      Next p
    End If
  Next t2
  
  
  
  For t1 = 0 To 80 Step 9’若在同行，同列，同一个九宫中有两数相同，则进入读档程序
    For t2 = 0 To 8
      For t3 = 0 To 8
      If a(t1 + t2, 0, m) = a(t1 + t3, 0, m) And t2 <> t3 Then
      
         If a(t1 + t2, 0, m) > 0 Then
        
         
          d = 1
         
         
          GoTo kkk
          End If
        End If
      Next t3
    Next t2
  Next t1
  
  
  
  
  

For p = 1 To 9’每次运算仅进行 行或列或小九宫，该段进行3个数组的数据更新
  For q = 1 To 9
    n = 9 * (p - 1) + q - 1
    o = 9 * (q - 1) + p - 1
    If p < 4 Then
      r = 3 * (q - Int((q - 0.1) / 3) * 3 - 1) + p
    End If
    If p > 3 And p < 7 Then
      r = 3 * (q - Int((q - 0.1) / 3) * 3 - 1) + 6 + p
    End If
    If p > 6 And p < 10 Then
      r = 3 * (q - Int((q - 0.1) / 3) * 3 - 1) + 9 * 2 - 6 + p
    End If
    r = r + (Int((q - 0.1) / 3) - 0) * 27 - 1
   
    If m = 0 Then
      a(r, 0, 2) = a(n, 0, 0)
      a(o, 0, 1) = a(n, 0, 0)
    End If
   
    If m = 1 Then
      a(r, 0, 2) = a(o, 0, 1)
      a(n, 0, 0) = a(o, 0, 1)
    End If
   
    If m = 2 Then
      a(n, 0, 0) = a(r, 0, 2)
      a(o, 0, 1) = a(r, 0, 2)
    End If
   
  Next q
Next p


Next m
'Next t


For t2 = 0 To 80’显示
   Text1(t2).Text = a(t2, 0, 0)
Next t2

Loop While t = 1
For t2 = 0 To 80’若没有可推理的解，则进行假设，对于最前面不可确定的数据进行假设，并在存档中删除这种可能性
  If a(t2, 0, 0) < 0 Then
    For p = 0 To 8
      If -a(t2, 0, 0) / 2 ^ p Mod 2 = 1 Then
        j = j + 1
        a(t2, 0, 0) = a(t2, 0, 0) + 2 ^ p
        For t1 = 0 To 80
           a(t1, j, 0) = a(t1, 0, 0)
        Next t1
        a(t2, 0, 0) = p + 1
        GoTo www
      End If
    Next p
  End If
Next t2
www:
If t2 <> 81 Then
  GoTo jin
End If









For t2 = 0 To 80
   Text1(t2).Text = a(t2, 0, 0)
Next t2

End Sub




Private Sub Form_Load()
Dim tt1, tt2 As Integer
For tt1 = 0 To 80
  Text1(tt1).Width = 220
Next tt1
For tt1 = 0 To 8
  For tt2 = 0 To 8
    Text1(tt1 * 9 + tt2).Left = tt1 * 350 + 730
    Text1(tt1 * 9 + tt2).Top = 370 + tt2 * 400
  Next tt2
Next tt1


For tt1 = 0 To 80
  Text1(tt1).Text = 0
Next tt1

End Sub


若删去：

For t2 = 0 To 80
  If a(t2, 0, 0) < 0 Then
    For p = 0 To 8
      If -a(t2, 0, 0) / 2 ^ p Mod 2 = 1 Then
        j = j + 1
        a(t2, 0, 0) = a(t2, 0, 0) + 2 ^ p
        For t1 = 0 To 80
           a(t1, j, 0) = a(t1, 0, 0)
        Next t1
        a(t2, 0, 0) = p + 1
        GoTo www
      End If
    Next p
  End If
Next t2
www:
If t2 <> 81 Then
  GoTo jin
End If

则可工作

数独,我也没好算法,我前面写的一个,不愿用循环,结果是用的随机数,
有些情况下是需要很多长时间的运算才能出结果.

明天我找一下出来.

谢谢

强悍！！！！！！！！！！！
这么长一段代码………………

因为是为自己写的,所以基本上没有注释.

Option Explicit

Private Type 单元格类型
   值 As Long
   可能(1 To 9) As Long
   计数 As Long
   原始 As Boolean
End Type

Dim dat(1 To 9, 1 To 9) As 单元格类型

Dim viewjs As Long

Private Sub Command1_Click()
   
    Dim i As Long
    Dim j As Long
   
    For i = 1 To 9
        For j = 1 To 9
            dat(i, j).值 = 0
            dat(i, j).计数 = 0
        Next j
    Next i
   
    Call viwe
End Sub


Private Sub Command2_Click()

Call inputdat
Dim i As Long
Dim j As Long

'Do

Do While i < 81
    j = i
    Call jsgc
    Call viwe
    i = viewjs
    If j = i Then       '此计算无效,需要随机掉一个数据
        Call jsRND
    End If
    Call viwe
    If i = viewjs And i = j Then        '随机掉数后,还是不能增加数据,无解
        'MsgBox "求解失败"
        Call Command3_Click
        Exit Do
    End If
Loop
   
    'If viewjs = 81 Then
        'MsgBox "求解成功"
        'Exit Do
    'End If
'Loop
'Call viwe
End Sub

Private Sub jsRND()

Dim i As Long
Dim j As Long
Dim exfor As Boolean

For i = 1 To 9
    For j = 1 To 9
        If dat(i, j).值 = 0 Then
            If dat(i, j).计数 > 1 Then
                dat(i, j).可能(1) = dat(i, j).可能(Int(Rnd() * dat(i, j).计数) + 1)
                dat(i, j).计数 = 1
                dat(i, j).计数 = 1
                dat(i, j).原始 = False
                exfor = True
                Exit For
            End If
        End If
    Next j
    If exfor Then Exit For
Next i

End Sub


Private Sub jsgc()

Dim i As Long
Dim j As Long

For i = 1 To 9
    For j = 1 To 9
        If dat(i, j).值 = 0 And dat(i, j).计数 <> 1 Then
            Call jsjg(i, j)
        End If
        If dat(i, j).计数 = 1 Then
            dat(i, j).值 = dat(i, j).可能(1)
            dat(i, j).原始 = False
        End If

    Next j
Next i

End Sub

Private Sub jsjg(x As Long, y As Long)

Dim k(1 To 9) As Long
Dim i As Long
Dim j As Long

For i = 1 To 9
    k(i) = i
Next i

For i = 1 To 9
    If dat(x, i).值 > 0 Then
        k(dat(x, i).值) = 0
    End If
Next i
For i = 1 To 9
    If dat(i, y).值 > 0 Then
        k(dat(i, y).值) = 0
    End If
Next i

Dim k1 As Long, k2 As Long
k1 = Int((x - 1) \ 3) * 3 + 1
k2 = Int((y - 1) \ 3) * 3 + 1

For i = k1 To k1 + 2
    For j = k2 To k2 + 2
    If dat(i, j).值 > 0 Then
        k(dat(i, j).值) = 0
    End If
    Next j
Next i

j = 1
For i = 1 To 9
    If k(i) > 0 Then
        dat(x, y).可能(j) = k(i)
        j = j + 1
    End If
Next i
dat(x, y).计数 = j - 1

End Sub


Private Sub inputdat()

    Dim i As Long
    Dim j As Long
    Dim k As String
   
    For i = 1 To 9
        For j = 1 To 9
            k = DAIUP(i * 9 + j - 10).Text
            If IsNumeric(k) Then
                dat(i, j).值 = CLng(k)
                If dat(i, j).值 > 9 Or dat(i, j).值 < 1 Then
                    dat(i, j).值 = 0
                End If
                If dat(i, j).值 > 0 Then
                    dat(i, j).原始 = True
                Else
                    dat(i, j).原始 = False
                End If
            End If
        Next j
    Next i
   
    Call viwe

End Sub

Private Sub viwe()

    Dim i As Long
    Dim j As Long
   
    viewjs = 81
    For i = 1 To 9
        For j = 1 To 9
            If dat(i, j).值 > 0 Then
                DAIUP(i * 9 + j - 10).Text = dat(i, j).值
            ElseIf dat(i, j).计数 = 1 Then
                DAIUP(i * 9 + j - 10).Text = dat(i, j).可能(1)
            Else
                DAIUP(i * 9 + j - 10).Text = ""
                viewjs = viewjs - 1
            End If
            If dat(i, j).原始 Then
                DAIUP(i * 9 + j - 10).ForeColor = 0
            Else
                DAIUP(i * 9 + j - 10).ForeColor = RGB(255, 0, 0)
            End If
        Next j
    Next i
    DoEvents
End Sub

Private Sub Command3_Click()
Dim i As Long
Dim j As Long
For i = 1 To 9
    For j = 1 To 9
        If Not dat(i, j).原始 Then
            DAIUP(i * 9 + j - 10).Text = ""
            dat(i, j).计数 = 0
            dat(i, j).值 = 0
        End If
    Next j
Next i
    'Call viwe
    Call Command2_Click
End Sub

Private Sub Command4_Click()
   
    Dim i As Long
    Dim j As Long
   
    Dim 间隔 As Long
   
    间隔 = 22
    Picture1.Cls
    For i = 1 To 9
       
        For j = 1 To 9
            Picture1.CurrentX = (j - 1) * 间隔 * 15
            Picture1.CurrentY = (i - 1) * 间隔 * 15
            If dat(i, j).原始 Then
                Picture1.ForeColor = 0
            Else
                Picture1.ForeColor = RGB(255, 0, 0)
            End If
           
            If dat(i, j).值 > 0 Then
                Picture1.Print dat(i, j).值
            ElseIf dat(i, j).计数 = 1 Then
                Picture1.Print dat(i, j).可能(1)
            Else
                DAIUP(i * 9 + j - 10).Text = ""
            End If
        Next j
    Next i
   
    Clipboard.Clear
    Clipboard.SetData Picture1.Image, vbCFBitmap
   
   
    DoEvents

End Sub

Private Sub Command5_Click()
   
    Dim i As Long
    Dim j As Long
    Dim k As String
    For i = 1 To 9
        For j = 1 To 9
            If dat(i, j).值 > 0 Then
                k = k & " " & dat(i, j).值
            Else
                k = k & " " & dat(i, j).可能(1)
            End If
        Next j
        k = k & vbCrLf
    Next i
   
    Clipboard.Clear
    Clipboard.SetText k
   
End Sub

Private Sub Form_Load()
Randomize Timer
End Sub

恩，我昨天晚上做了一个晚上，终于好了
bug消掉了。。。就是有一种可能性没考虑到。。。
悲剧

谢谢2楼的程序
我好好看一下，你的程序好像效率比我的高啊。。。

我把我的程序也发上来吧，
ps：原程序无注释。。。看起来可能比较落累。。。

稍看了一个你的代码头和我的代码头.终于找到速度的区别了.

--------这是你的数据定义------------
Dim a(81, 40, 3) As Integer         
定义为三维数组.
1\integer 是 16 位的,在 现在的CPU及系统中,字长是 32位,所以,long 数据类型运算速度是最快的.而 integer 需要扩展为 long 再进行运算,然后再收缩为 integer .多了一些开销.
2\我不知道你为什么第二维要定义 40 .
3\多维数组寻址时,系统需要计算一下这个素质的实际内存偏移量,需要一个计算开销.

--------我的定义-------------
Private Type 单元格类型
   值 As Long
   可能(1 To 9) As Long
   计数 As Long
   原始 As Boolean
End Type

Dim dat(1 To 9, 1 To 9) As 单元格类型
我定义是一个结构体.
1\这个结构体是固定长度的结构,也就是说占用内存是相同的.系统直接分配一块内存就可以放下,每个元素寻址与 单数据类型寻址基本相同.
2\结构中,每个数据位置是固定的,也就是直接进行固定的偏移量进行寻址就可以.不需要乘
3\总的数组是一个二维数组,计算元素偏移量时,不需要3次乘法,只需要2次乘.
4\数据类型要么就是 long ,要么就是用于逻辑判断的 byte 类型.(boolean 占一字节,只存储 0  或 非0(1/-1根据系统不同而不同,VB是1) )

哦，谢谢，我在程序中当算不出事需要假设的，所以后面的39个数组是用来放置假设前的数据用（是用来一层层的假设的，因为有时候假设的是错误的），我再去改一下