'这个在窗体 Option Explicit Dim Num(1 To 9, 1 To 9, 1 To 9) As String, Able(1 To 9, 1 To 9, 1 To 9) As Boolean Private Sub cmdCls_Click() Dim i As Integer, j As Integer, k As Integer '变量清零 For i = 1 To 9 For j = 1 To 9 For k = 1 To 9 Num(i, j, k) = "" Able(i, j, k) = False Next k Next j Next i For i = 1 To 81 NumIn(i).Text = "" Next i End Sub Private Sub CmdOk_Click() Dim i As Integer, j As Integer, k As Integer Dim X As Integer, Y As Integer, Z As Integer Dim d1 As Integer, d2 As Integer, TN As String, TL As Integer Dim Length As Integer, r As Integer Dim a As Integer, b As Integer, c As Integer, d As Integer, e As Integer, f As Integer '变量清零 For i = 1 To 9 For j = 1 To 9 For k = 1 To 9 Num(i, j, k) = "" Able(i, j, k) = False Next k Next j Next i '从Numin读值,并设置Able For i = 1 To 81 Y = i Mod 9 If i / 9 = 1 Or i / 9 = 2 Or i / 9 = 3 Or i / 9 = 4 Or i / 9 = 5 Or i / 9 = 6 Or i / 9 = 7 Or i / 9 = 8 Or i / 9 = 9 Then X = i / 9 Else X = i \ 9 + 1 End If If Y = 0 Then Y = 9 Select Case X Case 1 To 3 If Y <= 3 Then Z = 1 If Y >= 4 And Y <= 6 Then Z = 2 If Y >= 7 Then Z = 3 Case 4 To 6 If Y <= 3 Then Z = 4 If Y >= 4 And Y <= 6 Then Z = 5 If Y >= 7 Then Z = 6 Case 7 To 9 If Y <= 3 Then Z = 7 If Y >= 4 And Y <= 6 Then Z = 8 If Y >= 7 Then Z = 9 End Select Num(X, Y, Z) = CStr(NumIn(i).Text) Able(X, Y, Z) = True Next i '设其他值为1-9 For i = 1 To 9 For j = 1 To 9 For k = 1 To 9 If Num(i, j, k) = "" And Able(i, j, k) = True Then Num(i, j, k) = "123456789" End If Next k Next j Next i '计算 For r = 1 To 81 '删除同行列及方格中的数 For i = 1 To 9 For j = 1 To 9 For k = 1 To 9 If Able(i, j, k) = True Then Length = Len(Num(i, j, k)) If Length = 1 Then TN = Num(i, j, k) For d1 = 1 To 9 For d2 = 1 To 9 TL = Len(Num(i, d1, d2)) If TL <> 1 And Able(i, d1, d2) = True Then Call DelNum(TN, Num(i, d1, d2)) End If Next d2 Next d1 For d1 = 1 To 9 For d2 = 1 To 9 TL = Len(Num(d1, j, d2)) If TL <> 1 And Able(d1, j, d2) = True Then Call DelNum(TN, Num(d1, j, d2)) End If Next d2 Next d1 For d1 = 1 To 9 For d2 = 1 To 9 TL = Len(Num(d1, d2, k)) If TL <> 1 And Able(d1, d2, k) = True Then Call DelNum(TN, Num(d1, d2, k)) End If Next d2 Next d1 End If End If Next k Next j Next i '取唯一的可能值 For i = 1 To 9 For X = 1 To 9 For j = 1 To 9 For k = 1 To 9 If Able(i, j, k) = True Then a = InStr(Num(i, j, k), CStr(X)) If a <> 0 Then d = d + 1 End If If Able(j, i, k) = True Then b = InStr(Num(j, i, k), CStr(X)) If b <> 0 Then e = e + 1 End If If Able(j, k, i) = True Then c = InStr(Num(j, k, i), CStr(X)) If c <> 0 Then f = f + 1 End If Next k Next j If d = 1 Then For j = 1 To 9 For k = 1 To 9 If Able(i, j, k) = True Then a = InStr(Num(i, j, k), CStr(X)) If a <> 0 Then Num(i, j, k) = CStr(X) End If End If Next k, j End If d = 0 If e = 1 Then For j = 1 To 9 For k = 1 To 9 If Able(j, i, k) = True Then b = InStr(Num(j, i, k), CStr(X)) If b <> 0 Then Num(j, i, k) = CStr(X) End If End If Next k, j End If e = 0 If f = 1 Then For j = 1 To 9 For k = 1 To 9 If Able(j, k, i) = True Then c = InStr(Num(j, k, i), CStr(X)) If c <> 0 Then Num(j, k, i) = CStr(X) End If End If Next k, j End If f = 0 Next X Next i Next r '读出数据 For i = 1 To 81 Y = i Mod 9 If i / 9 = 1 Or i / 9 = 2 Or i / 9 = 3 Or i / 9 = 4 Or i / 9 = 5 Or i / 9 = 6 Or i / 9 = 7 Or i / 9 = 8 Or i / 9 = 9 Then X = i / 9 Else X = i \ 9 + 1 End If If Y = 0 Then Y = 9 Select Case X Case 1 To 3 If Y <= 3 Then Z = 1 If Y >= 4 And Y <= 6 Then Z = 2 If Y >= 7 Then Z = 3 Case 4 To 6 If Y <= 3 Then Z = 4 If Y >= 4 And Y <= 6 Then Z = 5 If Y >= 7 Then Z = 6 Case 7 To 9 If Y <= 3 Then Z = 7 If Y >= 4 And Y <= 6 Then Z = 8 If Y >= 7 Then Z = 9 End Select NumIn(i).Text = Num(X, Y, Z) Next i End Sub Private Sub Form_Load() '以下用来产生格子 Dim MyTop As Integer, MyLeft As Integer 'MyTop,MyLeft Dim i As Integer, j As Integer, k As Integer, n As Integer 'i,j,k MyTop = 200 For i = 1 To 9 MyLeft = 200 For j = 1 To 9 k = (i - 1) * 9 + j Load NumIn(k) NumIn(k).Text = NumIn(0).Text For n = 1 To 9 NumIn(k).AddItem (CStr(n)) Next n NumIn(k).Top = MyTop NumIn(k).Left = MyLeft NumIn(k).Visible = True NumIn(k).Enabled = True MyLeft = MyLeft + 1000 Next j MyTop = MyTop + 700 Next i End Sub '这个在模块 Sub DelNum(i As String, ByRef Num As String) Dim n As String, m As String, k As Integer, l As Integer k = InStr(Num, i) If k <> 0 Then n = Left(Num, k - 1) m = Mid(Num, k + 1) Num = n & m End If End Sub
|