Tô màu ô theo điều kiện và theo Sheets bằng VBA (1 người xem)

[hong loi]

Em muốn tô màu các ô ở sheet TongHop có value = 0 theo từng nhóm, mổi nhóm 1 màu riêng.
Mổi nhóm ở đây là tập hợp các ô có value = 0 và được paste link từ cùng 1 sheet.
ví dụ: (A6 ; A8:A9) được paste lnk từ sheet Cam là chung nhóm( nhóm 1).
(A15 : A16) được paste link từ sheet On là chung nhóm(nhóm 2).
(A21:A23 ; A28:A29) được paste link từ sheet Thay là chung nhóm(nhóm 3).

Em dùng code này

Sub HienMauOTrong()
Dim RngOTrong As Range
Endr = [A65000].End(xlUp).Row
Set RngOTrong = Range("A1").Resize(Endr, 1)
    For Each z In RngOTrong
        If z.Value = "0" Then
            z.Interior.ColorIndex = 3
            Else: z.Interior.ColorIndex = 0
        End If
    Next z
End Sub

Nhưng chỉ tô được mổi 1 màu đỏ.

Em muốn sửa code để mổi nhóm tô một màu riêng ví dụ như nhóm 1 màu đỏ, nhóm 2 màu xanh ,nhóm 3 màu vàng... (em dự định áp dụng cho file 21 sheet tương đương 20 màu).

Em thấy nếu có thể thay dòng code z.Interior.ColorIndex = 3.
Bằng z.Interior.ColorIndex = x với x là một biến số nguyên , biến x này phải bằng đúng vị trí sheet copy(Sheet copy là mấy sheet Cam, On ,Thay từ trái sang phải. Không dùng tên sheet vì code sẻ báo lổi khi ta sửa tên sheet). Hoặc biến x tự cộng thêm 1 khi code gặp ô có phần tên sheet của công thức paste link thay đổi, hay phải theo một hướng em chưa biết đến.

Ngẩm nghĩ mãi vẫn chưa biết làm thế nào nhờ các Thầy gở rối giúp em nhe.

 

[ndu96081631]

Em muốn sửa code để mổi nhóm tô một màu riêng ví dụ như nhóm 1 màu đỏ, nhóm 2 màu xanh ,nhóm 3 màu vàng... (em dự định áp dụng cho file 21 sheet tương đương 20 màu).

Hỏi lại: Tìm theo "nhóm" thì được rồi nhưng dựa vào đâu để biết nhóm nào tô màu gì? Hay cứ tô tùy ý, miễn sao chung nhóm thì cùng màu

 

[hong loi]

Hỏi lại: Tìm theo "nhóm" thì được rồi nhưng dựa vào đâu để biết nhóm nào tô màu gì? Hay cứ tô tùy ý, miễn sao chung nhóm thì cùng màu

Dạ "miễn sao chung nhóm thì cùng màu". Em cám ơn Thầy cùng tất cả mọi người trên GPE cảm thông cho em .

 

[ndu96081631]

Dạ "miễn sao chung nhóm thì cùng màu". .

Tôi thấy bài này dễ ồm chứ có gì đâu
Giờ tôi phải vào ca rồi (ca 3). Đến mai, nếu chưa có ai làm thì tôi sẽ giúp

 

[haiduong1993]

Bạn xem có phải vậy không

 

[ndu96081631]

Bạn xem có phải vậy không

Cũng hay nhưng... bài này chỉ cần 1 vòng lập là đủ
(ngoài ra việc bẫy lỗi cũng không kém phần quan trọng đấy)

 

[haiduong1993]

Cũng hay nhưng... bài này chỉ cần 1 vòng lập là đủ
(ngoài ra việc bẫy lỗi cũng không kém phần quan trọng đấy)

Nếu sử dụng 1 vòng lặp thì sửa lại code như nào vậy thầy, vì em cũng mới học VBA nên mong thầy chỉ dậy thêm

 

[ndu96081631]

Nếu sử dụng 1 vòng lặp thì sửa lại code như nào vậy thầy, vì em cũng mới học VBA nên mong thầy chỉ dậy thêm

Sửa theo code của bạn nhé:

Sub HienMauOTrong()
  Dim RngOTrong As Range, z As Range, wks As Worksheet
  [COLOR=#ff0000]Set RngOTrong = Range("A1:A100").SpecialCells(xlCellTypeFormulas)[/COLOR]
  For Each z In RngOTrong
    [COLOR=#ff0000]z.Interior.ColorIndex = xlNone[/COLOR]
    If z.Value = 0 Then
      [COLOR=#ff0000]Set wks = Range(z.Formula).Parent[/COLOR]
      [COLOR=#ff0000]If UCase(wks.Name) <> "TONGHOP" Then z.Interior.ColorIndex = 1+ wks.Index[/COLOR]
    End If
  Next z
End Sub

Chỗ màu đỏ là những chỗ thêm vào hoặc sửa lại
----------------------
Code này vẫn chưa bẫy lỗi đâu nha.. Chẳng hạn:
- Trong cột A, có cell nào đó có công thức =SUM(...) mà không phải là công thức Paste link thì code sẽ lỗi
- Trong cột A chẳng có cell nào chứa công thức thì code cũng lỗi
vân vân...
Các bạn tự suy nghĩ vụ bẫy lỗi này đi

 

[hong loi]

Bạn xem có phải vậy không

Mình cám ơn bạn đã giúp, code của bạn chạy tốt đấy cám ơn bạn nhiều nhé.

 

[hong loi]

Sửa theo code của bạn nhé:

Sub HienMauOTrong()
  Dim RngOTrong As Range, z As Range, wks As Worksheet
  [COLOR=#ff0000]Set RngOTrong = Range("A1:A100").SpecialCells(xlCellTypeFormulas)[/COLOR]
  For Each z In RngOTrong
    [COLOR=#ff0000]z.Interior.ColorIndex = xlNone[/COLOR]
    If z.Value = 0 Then
      [COLOR=#ff0000]Set wks = Range(z.Formula).Parent[/COLOR]
      [COLOR=#ff0000]If UCase(wks.Name) <> "TONGHOP" Then z.Interior.ColorIndex = 1+ wks.Index[/COLOR]
    End If
  Next z
End Sub

Chỗ màu đỏ là những chỗ thêm vào hoặc sửa lại
----------------------
Code này vẫn chưa bẫy lỗi đâu nha.. Chẳng hạn:
- Trong cột A, có cell nào đó có công thức =SUM(...) mà không phải là công thức Paste link thì code sẽ lỗi
- Trong cột A chẳng có cell nào chứa công thức thì code cũng lỗi
vân vân...
Các bạn tự suy nghĩ vụ bẫy lỗi này đi

Em rất vui được Thầy gở rối cho em, Thầy viết code rất linh hoạt, uyển chuyển, đa dạng, tùy cơ ứng biến. Vì thế code vừa ngắn gọn vừa phù hợp nhu cầu sử dụng đặc biệt là nhanh nhẹ .Đó là những đặc điểm em rất tâm đắc. Em cám ơn Thầy lắm .

Ồ may quá file của em chỉ có công thức paste link.