Xin gỏi các bạn tham khảo trò chơi xếp số theo 1 trật tự

Liên hệ QC

SA_DQ

/(hông là gì!
Thành viên danh dự
Tham gia
8/6/06
Bài viết
14,320
Được thích
22,361
Nghề nghiệp
Nuôi ba ba & trùn quế
Các bạn click chuột vô ô kề ô trống sẽ dịch chuyển các ô;
Tùy ý chọn một trật tư số để xếp;
Số bước: < 601
 

File đính kèm

  • XepSo15.rar
    12 KB · Đọc: 609
Ver 2.02 đây, Xin giới thiệu nhân dịp xuân về!

PHP:
Option Explicit
Dim StrC As String:     Global bRng As Range
Dim iZ As Integer:      Dim SoBuoc As Integer

Sub Auto_Open()
    Sheets("SaDQ").Select
    Set bRng = Range("C4:I9"):              Range("B3") = 0
End Sub
PHP:
Sub VanMoi()
On Error Resume Next
 Dim SNg As Integer:                 Dim Schu As String
 Dim Rng As Range
 
1 Auto_Open
 StrC = "254026392738283729360001020304050607080900"
 StrC = StrC & "101112131415161718192021222324303531343233"
3 For iZ = 1 To 999
    Randomize:                          SNg = 1 + Int(36 * Rnd())
5    If SNg > 12 Then
        StrC = Mid(StrC, 5, 2 * SNg) & Left(StrC, 4) & Mid(StrC, 5 + 2 * SNg)
7    Else
       StrC = Mid(StrC, 2 * SNg + 1, 10) & Left(StrC, 2 * SNg) + Mid(StrC, 11 + 2 * SNg)
9    End If
 Next iZ
11 iZ = 1
 Application.ScreenUpdating = 0
13 For Each Rng In bRng
    Schu = Mid(StrC, 2 * iZ - 1, 2)
15    Rng.Value = Val(Schu):            If Schu = "00" Then Rng.Value = ""
17    iZ = 1 + iZ
 Next Rng
19 Application.ScreenUpdating = True
End Sub
Mã:
[B]Private Sub Worksheet_SelectionChange(ByVal Target As Range)[/B] 
Dim wRng As Range, cRang As Range
 Dim iRow As Integer, iCol As Integer

 If Not Intersect(Target, bRng) Is Nothing Then
    For Each wRng In bRng
        With wRng
            iRow = Target.Row:              iCol = Target.Column
            iRow = iRow - wRng.Row:         iCol = iCol - wRng.Column
              
            If .Value = "" And KeNhau(iRow, iCol) Then
                .Value = Target.Value:      Target.Value = ""
                Exit For
            End If
        End With
    Next wRng
    Range("B3").Value = 1 + Range("b3").Value
 End If
 If Range("B3") > 2008 Then VanMoi
[B]End Sub[/B]
Mã:
[B]Function KeNhau[/B](iHang As Integer, iCot As Integer) As Boolean
 iHang = Abs(iHang):             iCot = Abs(iCot)

 If iHang = 0 And iCot = 1 Then KeNhau = -1
 If iCot = 0 And iHang = 1 Then KeNhau = -1
 If iCot = 0 And iHang = 0 Then KeNhau = -1

[B]End Function[/B]
 

File đính kèm

  • Num40.rar
    11.6 KB · Đọc: 84
  • Num40Ver2.02.rar
    12.6 KB · Đọc: 69
Lần chỉnh sửa cuối:
Web KT
Back
Top Bottom