Giới thiệu game trên excel: Sắp xếp theo màu sắc

[SA_DQ]

Mục tiêu: Dùng chuột để sắp xếp các cells theo cùng màu sắc
Download: http://www.ozgrid.com/forum/showthread.php?t=138696

Code sample:

Option Explicit:        Option Base 1
Public Blue As Byte, Buoc As Integer

Sub Auto_Open()
 On Error Resume Next
 Dim Jj As Byte, Zz As Byte
 Dim StrC As String
 
 StrC = "ABCDEFGHIJKLMNOPQRST":              Buoc = 0
 
 Zz = [H2].Value:                            ReDim Mg(Zz)
 Blue = 0:                                   ToMau Range("B2:F5")
 For Jj = 1 To Zz
   Randomize
   Zz = 1 + Int(19 * Rnd):                   If Zz > Len(StrC) Then Zz = Len(StrC)
   Mg(Jj) = Mid(StrC, Zz, 1)
   If Zz = 1 Then
      StrC = Mid(StrC, 2)
   Else
      StrC = Left(StrC, Zz - 1) & Mid(StrC, Zz + 1)
   End If
   ToMau Switch(Mg(Jj) = "A", [B2], Mg(Jj) = "B", [c2], Mg(Jj) = "C", [D2], Mg(Jj) = "D", [E2], _
               Mg(Jj) = "E", [F2], Mg(Jj) = "F", [B3], Mg(Jj) = "G", [C3], Mg(Jj) = "H", [D3], _
               Mg(Jj) = "I", [E3], Mg(Jj) = "J", [F3], Mg(Jj) = "K", [B4], Mg(Jj) = "L", [C4], _
               Mg(Jj) = "M", [D4], Mg(Jj) = "N", [E4], Mg(Jj) = "O", [F4], Mg(Jj) = "P", [B5], _
               Mg(Jj) = "Q", [C5], Mg(Jj) = "R", [D5], Mg(Jj) = "S", [E5], Mg(Jj) = "T", [F5])
  Next Jj
  [k3].Value = 1
End Sub

Sub ToMau(Rng As Range)
  With Rng.Interior
   If .ColorIndex = 3 Then
      .ColorIndex = 5:        .Pattern = 14
      Blue = Blue + 1
   Else
      .ColorIndex = 3:        .Pattern = 12
      Blue = Blue - 1
   End If
 End With
End Sub

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 If Not Intersect(Target, Range("B2:F5")) Is Nothing Then
   Dim Rng As Range, Clls As Range
   
   With Target
      If [k3].Value Mod 2 = 1 Then ToMau Target ''
      If [k3].Value < 3 Then
         Set Rng = Intersect(Range("B2:F5"), _
            Union(.Offset(-1), .Offset(, -1), .Offset(1), .Offset(, 1)))
      Else
         Set Rng = Intersect(Range("B2:F5"), _
            Union(.Offset(-1, -1), .Offset(1, -1), .Offset(-1, 1), .Offset(1, 1)))
      End If
   End With
   For Each Clls In Rng
      ToMau Clls
   Next Clls
 End If
 If Blue = 20 Or Blue = 0 Then
   MsgBox "You win!", , "GPE.COM Xin Chuc Mung!"
Auto_Open:        Auto_Open
 Else
   Buoc = Buoc + 1:                 [i2].Value = Buoc
 End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [H2]) Is Nothing Then
   Auto_Open
 ElseIf Not Intersect(Target, [k3]) Is Nothing Then
   Dim Rng As Range
   Range("j2:L4").Interior.ColorIndex = 0
   Select Case Target.Value
   Case 1
      Set Rng = Union(Range("J3:L3"), [k2], [k4])
   Case 2
      Set Rng = Union([j3], [l3], [k2], [k4])
   Case 3
      Set Rng = Union([J2], [j4], [l2], [l4], [k3])
   Case 4
      Set Rng = Union([J2], [j4], [l2], [l4])
   End Select
   Rng.Interior.ColorIndex = 3
 End If
End Sub