Bác Ba chưa nắm quy tắc trò chơi rồi
Bác Ba chưa nắm quy tắc trò chơi rồi
Đây là tất cả các cách xếp. Đúng là có 92 cách xếp khác nhau.
Code sẽ được post sau.
Làm như lão chết tiệt không nói sai bao giờ á. Nhưng dù sai cũng ngó kết quả 1 cái chứ bạn già.
Private Sub Worksheet_Change(ByVal target As Range)
Dim myRgn As Range
Set myRgn = Me.Range("B" & "8" & ":" & "I" & "1" & "5")
If target.Count = 1 Then
If Not Intersect(target, myRgn) Is Nothing Then
If target.Value <> "" Then
Func1 myRgn, target
Else: myRgn.ClearContents: End If: End If: End If: End SubPrivate gbVar1 As Long
Sub Func1(ByVal pram1 As Range, ByVal pram2 As Range)
Dim Var1() As Boolean, Var2(1 To 8, 1 To 8) As String, Var4 As Long, Var5 As Long
ReDim Var1(1 To pram1.Rows.Count, 1 To pram1.Columns.Count)
Var1(pram2.Row - pram1.Row + 1, pram2.Column - pram1.Column + 1) = True
gbVar1 = 0
Func2 Var1, 1
For Var4 = 1 To 8
For Var5 = 1 To 8
If Var1(Var4, Var5) Then Var2(Var4, Var5) = pram2.Value
Next
Next
pram1.Value = Var2
End Sub
Private Sub Func2(ByRef Var1() As Boolean, ByVal pram4 As Long)
Dim Var4 As Long, Var5 As Long, Var8, Var9 As Long
If gbVar1 = 8 Then Exit Sub
For Var4 = 1 To 8
If Var1(pram4, Var4) Then
Func2 Var1, pram4 + 1
Exit Sub
End If
Next
Var8 = Var1
For Var9 = 1 To 8
If gbVar1 = 8 Then Exit Sub
Var1 = Var8
Var1(pram4, Var9) = True
If Not Func3(Var1) Then
Func2 Var1, pram4 + 1
End If
Next
End Sub
Function Func3(ByRef Var1() As Boolean) As Boolean
Dim Var4 As Long, Var5 As Long, Var12 As Boolean
For Var4 = 1 To 8
Var12 = False
For Var5 = 1 To 8
If Var1(Var4, Var5) And Var12 Then
Func3 = True
Exit Function
Else
Var12 = Var1(Var4, Var5) Or Var12
End If
Next
Var12 = False
For Var5 = 1 To 8
If Var1(Var5, Var4) And Var12 Then
Func3 = True
Exit Function
Else
Var12 = Var1(Var5, Var4) Or Var12
End If
Next
Next
For Var4 = 1 To 7
Var12 = False
For Var5 = 1 To Var4
If Var1(Var4 - Var5 + 1, Var5) And Var12 Then
Func3 = True
Exit Function
Else
Var12 = Var1(Var4 - Var5 + 1, Var5) Or Var12
End If
Next
Var12 = False
For Var5 = 1 To 9 - Var4
If Var1(Var4 + Var5 - 1, Var5) And Var12 Then
Func3 = True
Exit Function
Else
Var12 = Var1(Var4 + Var5 - 1, Var5) Or Var12
End If
Next
Var12 = False
For Var5 = 9 - Var4 To 8
If Var1(Var4 + Var5 - 8, Var5) And Var12 Then
Func3 = True
Exit Function
Else
Var12 = Var1(Var4 + Var5 - 8, Var5) Or Var12
End If
Next
Var12 = False
For Var5 = Var4 To 8
If Var1(8 + Var4 - Var5, Var5) And Var12 Then
Func3 = True
Exit Function
Else
Var12 = Var1(8 + Var4 - Var5, Var5) Or Var12
End If
Next
Next
gbVar1 = 0
For Var4 = 1 To 8
For Var5 = 1 To 8
If Var1(Var4, Var5) Then gbVar1 = gbVar1 + 1
Next
Next
End FunctionThấy vùng B8:I16 thì chắc là code của bạn huuthang_bd sau vài lần replace.được dịch từ VBA sang VBA , đố bạn biết VBA gốc nằm ở đâu ?
Code này đơn giản nên việc tìm và thay thế cũng không mấy khó khăn. Chỉ có điều tên biến không mô tả nội dung nó lưu trữ nên việc đọc cũng hơi khó khăn. Nếu một dự án lớn thì việc dịch ngược cũng mất không ít thời gian àđược dịch từ VBA sang VBA , đố bạn biết VBA gốc nằm ở đâu ?
Code này đơn giản nên việc tìm và thay thế cũng không mấy khó khăn. Chỉ có điều tên biến không mô tả nội dung nó lưu trữ nên việc đọc cũng hơi khó khăn. Nếu một dự án lớn thì việc dịch ngược cũng mất không ít thời gian à
Đã vậy thì tôi gửi code luôn vậy.
Cũng dạng này nhưng có đề bài khó hơn: Viết code giải ô số Sudoku. Ai có hứng thú thì nhào vô
Option Explicit
Private userRow As Long, userCol As Long, EndGame As Boolean, strResult As String
Private Sub Worksheet_Change(ByVal target As Range)
Dim BanCo As Range, giatri, r As Long
EndGame = False
Set BanCo = Sheet1.Range("B8:I16")
giatri = target.Value
If Not IsArray(giatri) And Not Intersect(target, BanCo) Is Nothing Then
userRow = target.Row - 7
userCol = target.Column - 1
hell 1, ""
If EndGame Then
Application.EnableEvents = False
BanCo.ClearContents
For r = 1 To 8 Step 1
BanCo(Mid(strResult, r, 1), r) = giatri
Next
Application.EnableEvents = True
Else
MsgBox "ho^ng? tim` thay'"
End If
End If
End Sub
Private Sub hell(Col As Long, tmp As String)
Dim r As Long, u As Long
If Not EndGame Then
If Col < 9 Then
If Col <> userCol Then
For r = 1 To 8 Step 1
If InStr(1, tmp, r) = 0 And r <> userRow Then
For u = 1 To Col - 1 Step 1
If Abs(Mid(tmp, u, 1) - r) = Col - u Then Exit For
Next
If u > Col - 1 And Abs(userRow - r) <> Abs(userCol - Col) Then hell Col + 1, tmp & r
End If
Next
Else
hell Col + 1, tmp & userRow
End If
Else
EndGame = True
strResult = tmp
End If
End If
End SubMình có đề bài gởi các bạnNếu thích giao lưu Soduku mà phải điền bằng tay thì khổ lắm
Bạn có lòng tốt thì giúp mọi người 1 đoạn code lấy đề bài Sudoku từ trên mạng xuống trước đi , để có cái mà làm .
Tôi dịch bằng VBA nên cũng chẳng có gì ngạc nhiên khi một ai đó dùng VBA để dịch lại. Tuy nhiên cũng bởi vì tôi tự làm nên tôi biết không đơn giản chỉ là thay thế các biến.mình không được học hành gì nhiều , nên chỉ biết tự viết mã để replace các kí tự thôi à
Nếu có lòng , mời bạn cho mình thưởng thức dự án không nhỏ nào đó để giúp mình hoàn thiện cỗ máy replace với
Đề Sudoku thì dễ thôi. Bạn HieuCD đã đưa lên rồi đấy. Chắc đủ cho bạn test, khỏi cần lấy trên mạng nữa nhỉ.Nếu thích giao lưu Soduku mà phải điền bằng tay thì khổ lắm
Bạn có lòng tốt thì giúp mọi người 1 đoạn code lấy đề bài Sudoku từ trên mạng xuống trước đi , để có cái mà làm .
