Hãy xem sự di chuyển của trái 'Bi a' trên bàn! (1 người xem)

[ndu96081631]

Ngồi buồn quá, nghĩ ra trò này chơi... (giống như quả bi -a chạy vòng vòng trong 1 bàn vuông

Option Explicit
Public iR As Long, iC As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
Sub Bi_a()
  Dim i As Long
  For i = 1 To 1000
    With ActiveCell
      .Interior.ColorIndex = 0
      If .Row = 1 Then iR = 1
      If .Row = 20 Then iR = -1
      If .Column = 2 Then iC = 1
      If .Column = 52 Then iC = -1
      .Offset(iR, iC).Select
      Selection.Interior.ColorIndex = 3
    End With
    Sleep 10
  Next i
  Union([B1:B20], [AZ1:AZ20], [C1:AY1], [C20:AY20]).Interior.ColorIndex = 56
End Sub

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Application.EnableEvents = False
  If Target.Address = "$B$1" And Target.Count = 1 Then
    Call Bi_a
  End If
  Application.EnableEvents = True
End Sub

Các bạn tham khảo và cải tiến thêm nhé
Không biết chỉ với công thức có thể làm được trò này không nhỉ

 

[Po_Pikachu]

Bác có thể chỉnh code để click vào chỗ nào trên khung đen đó thì nó điều chạy được không (Và phải chạy bắt đầu từ điểm click đó).
Và nếu mai bác không có gì làm nữa (hiiii) thì bổ sung thêm 3 bi nữa để chạy chung thì vui lắm đó.
Và nên để Sleep (>100) thì mới được. Nhanh quá chẳng kịp nhìn thấy gì cả!!
Thanks.

 

[ndu96081631]

Bác có thể chỉnh code để click vào chỗ nào trên khung đen đó thì nó điều chạy được không (Và phải chạy bắt đầu từ điểm click đó).
Và nếu mai bác không có gì làm nữa (hiiii) thì bổ sung thêm 3 bi nữa để chạy chung thì vui lắm đó.
Và nên để Sleep (>100) thì mới được. Nhanh quá chẳng kịp nhìn thấy gì cả!!
Thanks.

Vậy thì Po_Pikachu chỉnh sửa đi ---> Cải tiến gì hay post lên chơi ---> Quan trọng là nghiên cứu thuật toán thôi mà (vừa chơi vừa học)
Tôi đang nghĩ đến hướng làm nó bằng công thức ---> Thế mới "độc" , nhưng đang vướng 1 vài chổ

 

[Po_Pikachu]

Vậy bác chờ em hoàn thành để án của mình trước đã!
Em còn nhiều việc làm hơn bác. Trong lúc chờ đợi em sẽ suy nghĩ về ý tưởng này.
Còn đáp án chắc bác sẽ phải làm trước thôi. Hiiii
Nhưng công thức đâu thể có tính năng Sleep đâu.
Nó mà chạy thì ... vèo. hết rồi!
Nhanh quá chừng luôn. Vậy làm sao lại Công Thức được sư phụ.
Cái quan trọng của code này chính là nhịp đập của Sleep kia. Thiếu nó không khác gì súng thiếu đạn vậy!
E rằng khó quá bác ơi!
Thân.

 

[ndu96081631]

Nhưng công thức đâu thể có tính năng Sleep đâu.
Nó mà chạy thì ... vèo. hết rồi!
Nhanh quá chừng luôn. Vậy làm sao lại Công Thức được sư phụ.
Cái quan trọng của code này chính là nhịp đập của Sleep kia. Thiếu nó không khác gì súng thiếu đạn vậy!
E rằng khó quá bác ơi!
Thân.

Chưa chắc đâu nha!
- Ta không chạy tự động nhưng ta sẽ chạy bằng cách bấm vào Spinner hoặc Scroll Bar ---> Mổi lần bấm sẽ "nhích" 1 cell ---> Cái quan trọng là làm sao "nhích? Có thể dùng hàm Cell ---> Nhưng vẫn còn chút khó khăn: Đó là vấn đề "đổi hướng" cho trái bi-a
(theo yêu cầu của bạn, đã sửa cho nó chậm đi rồi đầy... Ẹc.. Ẹc..)

 

[Po_Pikachu]

Phần đổi hướng Bi-Da đã làm được rồi! Đơn giản quá chừng luôn.
Còn vấn đề xung nhịp cho chương trình thì giao lại cho bác đó.
Heeee.
Xem file sẽ hiểu.
Thân.

 

[viendo]

Phần đổi hướng Bi-Da đã làm được rồi! Đơn giản quá chừng luôn.
Còn vấn đề xung nhịp cho chương trình thì giao lại cho bác đó.

Thêm scroll bar cho chạy thử, các Anh làm tiếp nhé.

 

[ndu96081631]

Các bạn làm hay lắm... nhưng mà để ý thấy khi trái bi -a chạm vào cạnh trên và văng ngược lại chưa chính xác lắm

 

[Po_Pikachu]

Cái này không phải em à nha!
Em lấy thông số vị trí từ file đầu tiên của bác đó.
Bác mở Sheet1 ra sẽ thấy 1000 dòng đó. Đó là 1000 dòng từ dòng For i = 1000 của bác mà.
Em đâu có thời gian đâu mà gõ 1000 dòng như thế chứ.
Vậy bác sữa code VBA trước đi. Em chỉ cần trích vị trí ra là xong ngay.
Heee heeee
Thân.

 

[ndu96081631]

Ý tôi muốn nói bạn kiểm tra lại vị trí trái bi-a khi A1 = 37, 38 và 39 ấy

 

[BNTT]

Thêm scroll bar cho chạy thử, các Anh làm tiếp nhé.

Viendo xem lại thử, khi A1 = 38, trái banh văng ra khỏi bàn luôn, tới khi A1 = 39 thì nó chui vô lại.

 

[Po_Pikachu]

Thôi được rồi, em đã chỉnh lại rồi!
Các xem file nha.
Thân.

 

[ndu96081631]

Bây giờ từ cơ sở của bài #1, các bạn để ý mỗi khi trái bi chạm vách thì màu đen của vách sẽ bị "ăn" mất ---> Câu hỏi đặt ra là: Thiết kế lại "bàn bi" sao cho trái bi có thể "ăn" toàn bộ vách bàn (sau 1 số lần chạm vách tùy ý)
Riêng đối với file dùng công thức, yêu cầu không được gõ công thức vào các cell nằm trong vùng "bàn bi" ---> Buộc dùng CF để tô màu
Các bạn nghiên cứu xem

 

[Po_Pikachu]

Em cũng đã hoàn thành xong nhiệm vụ! Rồi!
Chương trình không hề dùng VBA (Ý là toàn dùng công thức) nhưng code còn nhiều hơn cả chương trình (Vì phải dùng code mới làm nỗi 1000 đv).
Thôi chúc các bác vui.
Thân.

 

[BNTT]

Po_Pikachu ơi, chưa hoàn thành nhiệm vụ đâu:

Bây giờ từ cơ sở của bài #1, các bạn để ý mỗi khi trái bi chạm vách thì màu đen của vách sẽ bị "ăn" mất ---> Câu hỏi đặt ra là: Thiết kế lại "bàn bi" sao cho trái bi có thể "ăn" toàn bộ vách bàn (sau 1 số lần chạm vách tùy ý)

"Ăn toàn bộ", chứ không phải ăn một nửa chừa lại một nửa đâu...

Riêng đối với file dùng công thức, yêu cầu không được gõ công thức vào các cell nằm trong vùng "bàn bi" ---> Buộc dùng CF để tô màu

Công thức vẫn còn đầy trong bàn...

 

[Po_Pikachu]

Không dùng công thức trong bàn thì có thể làm được. Nhưng bảo ăn hết thì e rằng không được.
Xin báo cáo rằng đến số 900 thì nó sẽ chạy lại từ đầu và đi trên con đường quen thuộc. Vậy phải thiết kế lại bảng lệch pha sao? Và còn phải tăng lên 1800 thì mới ăn hết được.
Công việc nặng nhọc đây.
Thân.

 

[anhtuan1066]

Đây là file dùng công thức! Tôi làm như sau:
1> Đặt name:

Ban =Sheet1!$B$1:$AZ$20

chính là vùng chứa bàn bi-a

i =Sheet1!$A$1

chính là cell link của Scroll Bar

iR =i-((ROWS(Ban)-1)*2*INT((i-1)/((ROWS(Ban)-1)*2))+(MOD(i-1,(ROWS(Ban)-1))*2+1)*MOD(INT((i-1)/(ROWS(Ban)-1)),2)+ABS(MOD(INT((i-1)/(ROWS(Ban)-1)),2)-1))

Định vị dòng mới của quả bi-a

iC =i-((COLUMNS(Ban)-1)*2*INT((i-1)/((COLUMNS(Ban)-1)*2))+(MOD(i-1,(COLUMNS(Ban)-1))*2+1)*MOD(INT((i-1)/(COLUMNS(Ban)-1)),2)+ABS(MOD(INT((i-1)/(COLUMNS(Ban)-1)),2)-1))

Định vị cột mới của quả bi-a
2> Tiến hành tô màu bằng CF

a) Quét chọn vùng chứa bàn bi-a (trong file là B1:AZ20)
b) Vào menu Format\Conditional Formating, gõ vào công thức

=AND(ROW(B1)=iR+1,COLUMN(B1)=iC+2)

c) Tô màu nền theo ý muốn
​

3> Phát triển
- CF cho phép tô 3 màu, dựa vào cách tô màu của 1 quả bi-a, ta phát triển lên thành 3 quả chạy đuổi nhau bằng cách thêm name j, k, jR, jC, kR và kC.... Với j và k lệch với i 1 gia số tùy ý (có thể thí nghiệm)
- Cách đặt công thức cho 2 quả bi-a còn lại cũng tương tự

=AND(ROW(B1)=jR+1,COLUMN(B1)=jC+2)

và

=AND(ROW(B1)=kR+1,COLUMN(B1)=kC+2)

Quan trọng nhất vẩn là quá trình tính toán để tìm ra quy luật đổi hướng quả bi-a theo cell link... Trong file tôi để nguyên các cột công thức mà tôi thí nghiệm... Các bạn cứ tham khảo, nếu đã hiểu thì có thể xóa các cột này
Vẩn còn có thể cải tiến và rút gọn, các bạn nghiên cứu xem!
Mến
ANH TUẤN

 

[ptm0412]

Code VBA để chạy quả bida tương tự như bài này: đố vui về tô màu (bài 227)

 

[anhtuan1066]

Cải tiến lại file 1 chút
- Rút gọn name
- Thêm tùy chọn số quả bi xuất hiện trên bàn (bằng CheckBox)