Đếm ô để set màu

[bobovnu]

Bác có file nào khác giống như vầy không! Chứ em download về nó báo lỗi rồi không đọc được!
Các anh chị giúp e với, dân ko chuyên nên khổ thế đấy ạ. E xin cảm ơn trước ạ.

Xin các bác tải file về giúp em ạ.
YM của em: Thienvnu

Rất mong tin của các bác.
Tạm thời sau 3 bước ta sẽ có các hình như trong file này ạ. (202.xls)

 

[bobovnu]

UNION() ở trong excel là 1 phương thức dùng để nối kết các ô hay vùng ô trên 1 sheet;
(Returns the union of two or more ranges.)
Ngược lại, là người tự học nên các toán tử NOR & NAND mình hiếm & chưa xài bao giớ;
Có lẻ chúng giành cho những chuyên tin học hay sao í chứ!

Anh xem lại chỗ này cho e phát:
Khảo sát ô x bất kì tại lần thứ t Phụ thuộc vào các ô xung quanh của 2 thời điểm trước đó. Ví dụ, khi r=1, cần xác định xem ô x này là 0 hay 1, như sau: Ri=Pi XOR Qi (i=1,..8) và: R=R1 XOR R2 XOR…R8

Giá trị của các phép toán logic đây ạ
http://en.wikipedia.org/wiki/Logic_function
Ý em là mình phải có 3 mảng, mảng 1 lưu lại các giá trị 0 và 1 tại thời điểm t-2, mảng 2 là các giá trị tại thời điểm t-1, và mảng 3 là ở thời điểm t hiện tại đc tính từ 2 mảng trước.

 

[SA_DQ]

Anh xem lại chỗ này cho e phát:
Khảo sát ô x bất kì tại lần thứ t Phụ thuộc vào các ô xung quanh của 2 thời điểm trước đó. Ví dụ, khi r=1, cần xác định xem ô x này là 0 hay 1, như sau: Ri=Pi XOR Qi (i=1,..8) và: R=R1 XOR R2 XOR…R8 Ý em là mình phải có 3 mảng, mảng 1 lưu lại các giá trị 0 và 1 tại thời điểm t-2, mảng 2 là các giá trị tại thời điểm t-1, và mảng 3 là ở thời điểm t hiện tại đc tính từ 2 mảng trước.

Hiện tại, tại [A1] đang ghi số lần chạy macro
Mình định thực hiện iêu cầu của bạn bằng cách thức sau:

Sau khi chạy Autpen() ta chép bảng màu đến BangA (biểu thị bằng số 1 & 0 trên các ô tương ứng)
trước khi chạy macro ToMau() ta chép BangA =>> BangB & Sau khi macro kết thúc ta lại chép Bảng màu đến BangA
. . . . & cứ thế trình tự tiếp diễn trong bảng màu & 3 bảng lưu tín hiệu 1 & 0

Nếu dồng ý như vậy thì bạn thử sức trong 24 giờ xem sao; Mình gơi í dùng thuộc tính Offset() đề chép xuống dưới cách ô hiện hữu 60 ô:

For Each Clls in Rng
  If Clls.Interior.ColorIndex = 5 then Clls.OffSet(60*n)= '1' Else Clls.Offset(60*n)="O"
Next Clls

(n = 1-3)

 

[bobovnu]

Hiện tại, tại [A1] đang ghi số lần chạy macro
Mình định thực hiện iêu cầu của bạn bằng cách thức sau:

Sau khi chạy Autpen() ta chép bảng màu đến BangA (biểu thị bằng số 1 & 0 trên các ô tương ứng)
trước khi chạy macro ToMau() ta chép BangA =>> BangB & Sau khi macro kết thúc ta lại chép Bảng màu đến BangA
. . . . & cứ thế trình tự tiếp diễn trong bảng màu & 3 bảng lưu tín hiệu 1 & 0

Nếu dồng ý như vậy thì bạn thử sức trong 24 giờ xem sao; Mình gơi í dùng thuộc tính Offset() đề chép xuống dưới cách ô hiện hữu 60 ô:

For Each Clls in Rng
  If Clls.Interior.ColorIndex = 5 then Clls.OffSet(60*n)= '1' Else Clls.Offset(60*n)="O"
Next Clls

(n = 1-3)

Hic hic, e đã tạo đc 3 bảng, nhưng vữn ko tính đc với các phép toán theo đề bài ban đầu.. Hic hic.

 

[SA_DQ]

Cụ thể hóa 1 phần của #24

Option Explicit
Sub MoveTo3()
 Dim SoNgau As Byte, SoNg2 As Byte, bDm As Byte
 Dim Clls As Range
1 ' To Mau Table(G)'
  Randomize:            Range("B2:D4").Clear
 
  SoNgau = 1 + Int(9 * Rnd)
  If SoNgau > 4 Then SoNg2 = SoNgau - 4 Else SoNg2 = SoNgau + 4
  For Each Clls In Range("B2:D4")
    bDm = bDm + 1
    If bDm = SoNgau Or bDm = SoNg2 Then _
        Clls.Interior.ColorIndex = 5
  Next Clls
2 ' Copy Tu (2)=>>(3)'
  [b22].Resize(3, 3).Copy Destination:=[b32]
3 ' Copy Tu (1)=>>(2)'
  [b12].Resize(3, 3).Copy Destination:=[b22]
4 'Dich Tu (G)==>>(1)'
  For Each Clls In Range("B2:D4")
    If Clls.Interior.ColorIndex = 5 Then
        Clls.Offset(10) = 1
    Else
        Clls.Offset(10) = 0
    End If
  Next Clls
    [a4] = [a4] + 1
End Sub

 

[bobovnu]

Bạn chép tất thẩy ba macro này thay cho các macro cũ, nha!

Option Explicit:                 Option Base 1
Dim Rng9 As Range:               Dim bXh As Byte, bDem As Byte

Sub ToMau()
 ReDim MSo(2500) As Byte:               Dim yY As Long
2 Dim Rng As Range, Clls As Range
 Dim iJ As Integer, Xx As Integer

4 For Each Rng In Range("B2:AY51")
   iJ = iJ + 1
6   yY = Rng.Row:           Xx = Rng.Column
   If yY = 2 And Xx = 2 Then           'O Tren Trai Nhat'
8      Set Rng9 = Union(Rng.Resize(2, 2), Cells(yY, 51).Resize(2, 1), _
         Cells(51, 2).Resize(1, 2), Cells(51, 51))
10      Color9 Rng9:                     Set Rng9 = Nothing
      MSo(iJ) = bXh Mod 2:             bXh = 0
12   ElseIf yY = 2 And Xx = 51 Then      'O Tren Phai Nhat'
      Set Rng9 = Union(Cells(2, 2).Resize(2, 1), Cells(2, 50).Resize(2, 2), _
         Cells(51, 2), Cells(51, 50).Resize(1, 2))
14         Color9 Rng9:                     Set Rng9 = Nothing
         MSo(iJ) = bXh Mod 2:             bXh = 0
16   ElseIf yY = 51 And Xx = 2 Then      'O Duoi Trai Nhat'
      Set Rng9 = Union(Cells(2, 2).Resize(1, 2), Cells(2, 51), _
         Cells(50, 2).Resize(2, 2), Cells(50, 51).Resize(2, 1))
18      Color9 Rng9:                     Set Rng9 = Nothing
      MSo(iJ) = bXh Mod 2:             bXh = 0
20   ElseIf yY = 51 And Xx = 51 Then     'O Duoi Phai Nhat'
      Set Rng9 = Union(Cells(2, 2), Cells(2, 50).Resize(1, 2), _
         Cells(50, 2).Resize(2, 1), Cells(50, 50).Resize(2, 2))
22      Color9 Rng9:                     Set Rng9 = Nothing
      MSo(iJ) = bXh Mod 2:             bXh = 0
24   ElseIf yY = 2 Then                  'Cac O Con Lai Cua Cot 'B''
      Color9 Union(Rng.Offset(, -1).Resize(2, 3), Rng.Offset(49, -1).Resize(1, 3))
26      MSo(iJ) = bXh Mod 2:             bXh = 0
   ElseIf Xx = 2 Then                  'Cac O Con Lai Cua Dong '2''
28      Color9 Union(Rng.Offset(-1).Resize(3, 2), Rng.Offset(-1, 49).Resize(3, 1))
      MSo(iJ) = bXh Mod 2:             bXh = 0
30   ElseIf Xx = 51 Then                 'Cac O Con Lai Cua Cot Cuoi'
      Color9 Union(Rng.Offset(-1, -49).Resize(3, 1), Rng.Offset(-1, -1).Resize(3, 2))
32      MSo(iJ) = bXh Mod 2:             bXh = 0
   ElseIf yY = 51 Then                 'Cac O Con Lai Cua Hang Cuoi'
34      Color9 Union(Rng.Offset(-49, -1).Resize(1, 3), Rng.Offset(-1, -1).Resize(2, 3))
      MSo(iJ) = bXh Mod 2:             bXh = 0
36   Else                                '2.500-198 O Con Lai'
      Color9 Rng.Offset(-1, -1).Resize(3, 3)
38      MSo(iJ) = bXh Mod 2:             bXh = 0
   End If
40 Next Rng

 iJ = 0
42 For Each Rng In Range("B2:AY51")
   iJ = 1 + iJ
44   Rng.Interior.ColorIndex = IIf(MSo(iJ) = 1, 5, 0)          '3'
 Next Rng
46 bDem = bDem + 1:                       [A1].Select
 [A1] = bDem
End Sub

[B]Sub Color9(Rng9 As Range)[/B]
 Dim Clls As Range
 For Each Clls In Rng9
   If Clls.Interior.ColorIndex = 5 Then bXh = 1 + bXh          '3'
 Next Clls
[B]End Sub[/B]

Sub Auto_Open()
 Dim StrC As String, ChuSo As String
 Dim SoNgau As Byte, bZ As Byte, bW As Byte
 'Tao 10% Cells Ngau Nhien'
 Sheets("S2").Select: [A1] = 0
 Range(Cells(2, 2), Cells(51, 51)).Clear
 For bZ = 1 To 50
   SoNgau = 0:                      bDem = 0
   For bW = 0 To 4
      Randomize:           SoNgau = 10 * bW + Int(10 * Rnd)   '1- SoNgau'
      Cells(bZ + 1, SoNgau + 2).Interior.ColorIndex = 5        '3'
   Next bW
 Next bZ
End Sub

Nếu cần giải thích dòng lệnh nào thì cứ réo, nha!

Chúc Vui Vẽ!!!​

Anh ơi,
Cái biến bXh anh dùng để đếm số ô đen xung quanh của bước trước. Nhưng đấy là hệ quả của phép toán XOR. Nếu thay bởi các phép toán khác, AND, OR,... thì làm thiế nào?
Vả lại, đầu bài yêu cầu thực hiện liên tiếp (8 ô xung quanh) phép toán logic (ví dụ phép XOR) ở 2 thời điểm trước. Ở đây anh mới chỉ quan tâm tới 1 thời điểm trước. Như anh gợi ý cho em, tức là phải kết quả hiện tại là bảng C, được lấy từ Bảng A và B trước đó. Khởi tạo 2 lần đầu là ngẫu nhiên. Chắc do em giải thích đề bài ko đc rõ.. E đã có thể "truy cập" được data của 2 bảng A và B, nhưng khi thực hiện thay đổi thành các phép toán AND, OR, ...thì chạy ko đúng. Hic hic/
Ah nữa, đúng là anh đếm cả ô giữa, nên kết quả chưa chính xác
Anh coi lại dùm iem phát nha.

 

[SA_DQ]

Thì không đếm ô giữa nữa, nó đây!

Anh ơi, Ah nữa, đúng là anh đếm cả ô giữa, nên kết quả chưa chính xác
Anh coi lại dùm iem phát nha.

Option Explicit:                 Option Base 1
Dim Rng9 As Range:               Dim bXh As Byte, bDem As Byte

Sub ToMau()
 ReDim MSo(2500) As Byte:               Dim yY As Long
2 Dim Rng As Range, Clls As Range
 Dim iJ As Integer, Xx As Integer

4 For Each Rng In Range("B2:AY51")
   iJ = iJ + 1
6   yY = Rng.Row:           Xx = Rng.Column
   If yY = 2 And Xx = 2 Then           'O Tren Trai Nhat'
8      Set Rng9 = Union(Rng.Offset(1).Resize(1, 2), Rng.Offset(, 1), Cells(yY, 51) _
         .Resize(2, 1), Cells(51, 2).Resize(1, 2), Cells(51, 51))
10      Color9 Rng9:                     Set Rng9 = Nothing
      MSo(iJ) = bXh Mod 2:             bXh = 0
12   ElseIf yY = 2 And Xx = 51 Then      'O Tren Phai Nhat'
      Set Rng9 = Union(Cells(2, 2).Resize(2, 1), Cells(2, 50).Resize(2, 1), _
         Cells(2, 51).Offset(1), Cells(51, 2), Cells(51, 50).Resize(1, 2))
14         Color9 Rng9:                     Set Rng9 = Nothing
         MSo(iJ) = bXh Mod 2:             bXh = 0
16   ElseIf yY = 51 And Xx = 2 Then      'O Duoi Trai Nhat'
      Set Rng9 = Union(Cells(2, 2).Resize(1, 2), Cells(2, 51), _
         Cells(50, 2).Resize(1, 2), Cells(51, 2).Offset(, 1), Cells(50, 51).Resize(2, 1))
18      Color9 Rng9:                     Set Rng9 = Nothing
      MSo(iJ) = bXh Mod 2:             bXh = 0
20   ElseIf yY = 51 And Xx = 51 Then     'O Duoi Phai Nhat'
      Set Rng9 = Union(Cells(2, 2), Cells(2, 50).Resize(1, 2), _
         Cells(50, 2).Resize(2, 1), Cells(50, 50).Resize(2, 1), Cells(50, 51))
22      Color9 Rng9:                     Set Rng9 = Nothing
      MSo(iJ) = bXh Mod 2:             bXh = 0
24   ElseIf yY = 2 Then                  'Cac O Con Lai Cua Cot 'B''
      Color9 Union(Rng.Offset(-1), Rng.Offset(1), Rng.Offset(-1, 1).Resize(3, 1), _
         Rng.Offset(-1, 49).Resize(3, 1))
26      MSo(iJ) = bXh Mod 2:             bXh = 0
   ElseIf Xx = 2 Then                  'Cac O Con Lai Cua Dong '2''
28      Color9 Union(Rng.Offset(, -1), Rng.Offset(, 1), Rng.Offset(1, -1).Resize(1, 2), _
         Rng.Offset(49, -1).Resize(1, 3))
      MSo(iJ) = bXh Mod 2:             bXh = 0
30   ElseIf Xx = 51 Then                 'Cac O Con Lai Cua Cot Cuoi'
      Color9 Union(Rng.Offset(-1, -49).Resize(3, 1), Rng.Offset(-1, -1).Resize(3, 1) _
         , Rng.Offset(-1), Rng.Offset(1))
32      MSo(iJ) = bXh Mod 2:             bXh = 0
   ElseIf yY = 51 Then                 'Cac O Con Lai Cua Hang Cuoi'
34      Color9 Union(Rng.Offset(-49, -1).Resize(1, 3), Rng.Offset(-1, -1).Resize(1, 3) _
            , Rng.Offset(, -1), Rng.Offset(, 1))
      MSo(iJ) = bXh Mod 2:             bXh = 0
36   Else                                '2.500-198 O Con Lai'
      Color9 Union(Rng.Offset(-1, -1).Resize(1, 3), Rng.Offset(, -1), Rng.Offset(, 1), _
         Rng.Offset(1, -1).Resize(1, 3))
38      MSo(iJ) = bXh Mod 2:             bXh = 0
   End If
40 Next Rng

 iJ = 0
42 For Each Rng In Range("B2:AY51")
   iJ = 1 + iJ
44   Rng.Interior.ColorIndex = IIf(MSo(iJ) = 1, 5, 0)          '3'
 Next Rng
46 bDem = bDem + 1:                       [a1].Select
 [a1] = bDem
End Sub

Sub Color9(Rng9 As Range)
 Dim Clls As Range
 For Each Clls In Rng9
   If Clls.Interior.ColorIndex = 5 Then bXh = 1 + bXh
 Next Clls
End Sub