Xin gởi tới các bạn trò vui trên trang tính excel

[SA_DQ]

Nhiệm vụ là nhấn double vô 1 trong 16 ô của hình vuông cho đến khi các ô có cùng một màu

Muốn ván mới ta chọn 1 trong bốn số của ô đang chứa số {1; 2; 3; 4}

Xin các bạn góp thêm ý kiến, chúng ta cùng cải tiến!

 

[rollover79]

Nhiệm vụ là nhấn double vô 1 trong 16 ô của hình vuông cho đến khi các ô có cùng một màu

Muốn ván mới ta chọn 1 trong bốn số của ô đang chứa số {1; 2; 3; 4}

Xin các bạn góp thêm ý kiến, chúng ta cùng cải tiến!

Tôi xin có vài nhận xét như sau:
1. Việc chọn ngẫu nhiên số ô có màu xanh ban đầu chưa hay lắm. Cứ thử chọn liên tiếp 4 ô sẽ có trường hợp nó chỉ có 3 ô màu xanh.
2. Đã có sub để thực hiện việc tô màu, nhưng tại sự kiện thì không sử dụng mà lại tô màu trực tiếp dẫn đến không thống nhất(Cụ thể ở đây là không có Partern)
3. Sau mỗi bước thực hiện lại phải duyệt lại toàn bộ để đếm số màu tương ứng. Trong khi đó có thể dùng 1 biến toàn cục lưu lại số màu xanh. Khi khởi tạo thì gán bằng giá trị tại ô G2, mỗi khi đổi màu 1 ô thì cộng hoặc trừ đi 1 tùy theo màu đã thay đổi.
4. Đoạn code này

      If Not Intersect(Target, Range("C3:D4")) Is Nothing Then
         Set rng = Union(.Offset(-1), .Offset(, -1), .Offset(1), .Offset(, 1))
      ElseIf Not Intersect(Target, Range("C2:D2")) Is Nothing Then
         Set rng = Union(.Offset(, -1), .Offset(1), .Offset(, 1))
      ElseIf Not Intersect(Target, Range("C5:D5")) Is Nothing Then
         Set rng = Union(.Offset(, -1), .Offset(-1), .Offset(, 1))
      ElseIf Not Intersect(Target, Range("B3:B4")) Is Nothing Then
         Set rng = Union(.Offset(-1), .Offset(1), .Offset(, 1))
      ElseIf Not Intersect(Target, Range("E3:E4")) Is Nothing Then
         Set rng = Union(.Offset(-1), .Offset(1), .Offset(, -1))
      ElseIf Not Intersect(Target, [B2]) Is Nothing Then
         Set rng = Union(.Offset(1), .Offset(, 1))
      ElseIf Not Intersect(Target, [B5]) Is Nothing Then
         Set rng = Union(.Offset(-1), .Offset(, 1))
      ElseIf Not Intersect(Target, [E2]) Is Nothing Then
         Set rng = Union(.Offset(1), .Offset(, -1))
      ElseIf Not Intersect(Target, [E5]) Is Nothing Then
         Set rng = Union(.Offset(-1), .Offset(, -1))
      End If

Có thể thay bằng 1 dòng code duy nhất

      Set rng = Intersect(Range("B2:E5"), Union(.Offset(-1), .Offset(, -1), .Offset(1), .Offset(, 1)))

 

[SA_DQ]

4. Đoạn code này có thể thay bằng 1 dòng code . . .

Rất cảm ơn bạn!

Đúng là có thể bỏ chỉ để lại 1 dòng lệnh duy nhứt trong 19 dòng lệnh, đó là:

Set rng = Union(.Offset(-1), .Offset(, -1), .Offset(1), .Offset(, 1))

Nhưng nếu không thêm các dòng lệnh khác thì macro sẽ tô các ô ngoài phạm vi 16 ô của trò chơi;
Vì vậy macro được sửa lại như sau:

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 If Not Intersect(Target, Range("B2:E5")) Is Nothing Then
   Dim Rng As Range, Clls As Range, nRng As Range  'Khai Them Bien'
   Dim Red As Byte, Blue As Byte
   
   With Target
      With .Interior
         If .ColorIndex = 3 Then
            .ColorIndex = 5
         Else
            .ColorIndex = 3
         End If
      End With
      Set Rng = Union(.Offset(-1), .Offset(, -1), .Offset(1), .Offset(, 1))
   End With
'Gan Cac O Bien Vo Bien Vua Khai Bao:'
   Set nRng = Union(Range("B1:E1"), Range("A2:A5"), Range("F2:F5"), Range("B6:E6"))
   For Each Clls In Rng
      If Intersect(Clls, nRng) Is Nothing Then  'Loai Tru Cac O Nam Ke Tren Bien'
         With Clls.Interior
            If .ColorIndex = 3 Then
               .ColorIndex = 5
            Else
               .ColorIndex = 3
            End If
         End With
      End If          '<=|'
   Next Clls
 End If
 Set Rng = Range("B2:E5")
 For Each Clls In Rng
   With Clls.Interior
      If .ColorIndex = 3 Then
         Red = Red + 1
      Else
         Blue = 1 + Blue
      End If
      If Red > 0 And Blue > 0 Then Exit For
   End With
 Next Clls
 If Red = 0 Or Blue = 0 Then MsgBox "You win!", , "GPE.COM Xin Chuc Mung!"
End Sub

 

[rollover79]

Rất cảm ơn bạn!

Đúng là có thể bỏ chỉ để lại 1 dòng lệnh duy nhứt trong 19 dòng lệnh, đó là:

Set rng = Union(.Offset(-1), .Offset(, -1), .Offset(1), .Offset(, 1))

Nhưng nếu không thêm các dòng lệnh khác thì macro sẽ tô các ô ngoài phạm vi 16 ô của trò chơi;

Đúng là thay bằng dòng này thì nó sẽ tô ra ngoài, nhưng dòng của tôi ở bài dưới khác với dòng này mà, chắc sẽ không tô ra ngoài được.

 

[SA_DQ]

Đã khắc phục toàn bộ bốn điểm yếu mà bạn đã nêu trong hai bài góp cho mình;

Có sự góp sức của bạn, các macro trở nên nhẹ đi nhiều

Xin gỏi file đính kèm đã sửa đổi & bổ sung

Xin chân thành cảm tạ!

 

[rollover79]

- Theo tôi thì khi kết thúc(hoàn thành) cần có thêm 1 số thông tin nữa cho vui.
1. Tổng thời gian đã thực hiện.
2. Tổng số bước đã thao tác(số lần kích đúp).
3. Nếu lưu lại được thông tin kỷ lục về thời gian và số bước thì càng tốt.
- Code đang thực hiện đúng, nhưng hơi "mong manh", thử kiểm tra với 3 trường hợp sau(3 trường hợp riêng biệt).
1. Nếu bỏ dòng On Error Resume Next trong Autpen, code sẽ chết ngay .
2. Nếu thay kiểu của 2 biên Red và Blue từ kiểu Byte sang kiểu Integer, code chạy sẽ không còn đúng nữa.
3. Trong ToMau, nếu đổi chỗ 2 câu lệnh Blue = Blue - 1:Red = Red + 1 thành Red = Red + 1:Blue = Blue - 1 code chạy cũng không còn đúng nữa.
- Thêm 1 ý nữa, là chỉ cần dùng 1 biến đếm Blue hoặc Red là đủ, không nhất thiết phải dùng 2 biến. Khi kiểm tra chỉ cần kiểm tra biến này là 0 hoặc 16.

 

[SA_DQ]

Tiếp tục cải tiến nhờ sự góp ý của các bạn

Để người chơi dễ đến với chiến thắng, trong quá trình chơi, người chơi có thể chọn 1 trong bốn cách tô đổi màu như macro dưới đây:

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