Đổ màu theo vị trí công việc (1 người xem)

[redevinte]

Tôi muốn đổ màu vào các ô theo vị trí công việc đã được liệt kê sẵn, yêu cầu được ghi ở trong file gửi kèm, nhờ anh chị em kiểm tra file gửi kèm và giúp đỡ.

 

[Quang_Hải]

Tôi muốn đổ màu vào các ô theo vị trí công việc đã được liệt kê sẵn, yêu cầu được ghi ở trong file gửi kèm, nhờ anh chị em kiểm tra file gửi kèm và giúp đỡ.

Thử macro này

Sub tomau()
Dim r, x, rng As Range, tam
Set rng = [H2:K2]
For r = 2 To 6
   tam = Split(Cells(r, 2), ",")
   If UBound(tam) = 0 Then
      Cells(r, 3).Resize(, 4).Interior.ColorIndex = _
      rng.Find(Cells(r, 2), , , 1).Interior.ColorIndex
   ElseIf UBound(tam) = 1 Then
      Cells(r, 3).Resize(, 2).Interior.ColorIndex = _
      rng.Find(Trim(tam(0)), , , 1).Interior.ColorIndex
      Cells(r, 5).Resize(, 2).Interior.ColorIndex = _
      rng.Find(Trim(tam(1)), , , 1).Interior.ColorIndex
   ElseIf UBound(tam) = 2 Then
      Cells(r, 3).Interior.ColorIndex = _
      rng.Find(Trim(tam(0)), , , 1).Interior.ColorIndex
      Cells(r, 4).Interior.ColorIndex = _
      rng.Find(Trim(tam(1)), , , 1).Interior.ColorIndex
      Cells(r, 5).Resize(, 2).Interior.ColorIndex = _
      rng.Find(Trim(tam(2)), , , 1).Interior.ColorIndex
   ElseIf UBound(tam) = 3 Then
      For x = 0 To 3
         Cells(r, x + 3).Interior.ColorIndex = _
         rng.Find(Trim(tam(x)), , , 1).Interior.ColorIndex
      Next
   End If
Next
End Sub

 

[vu_tuan_manh_linh]

Tôi muốn đổ màu vào các ô theo vị trí công việc đã được liệt kê sẵn, yêu cầu được ghi ở trong file gửi kèm, nhờ anh chị em kiểm tra file gửi kèm và giúp đỡ.

Yêu cầu của bạn là "bắt buộc" hay có thể thay đổi cách hiển thị khác không?

 

[redevinte]

Yêu cầu của bạn là "bắt buộc" hay có thể thay đổi cách hiển thị khác không?

Bắt buộc bạn ạ (cái này không phải do bên tôi quy định ra, do bên công ty khách hàng yêu cầu thế).
Tuy nhiên bạn có thể đưa ra hướng của bạn để mọi người tham khảo và học hỏi. Tôi cũng muốn học hỏi thêm.

 

[redevinte]

Thử macro này

Chưa kịp thử, cảm ơn bạn trước, nếu có gì bất cập tôi sẽ phản hồi để nhờ bạn giúp đỡ.

 

[redevinte]

Chưa kịp thử, cảm ơn bạn trước, nếu có gì bất cập tôi sẽ phản hồi để nhờ bạn giúp đỡ.

Tôi thay đổi đề một chút, các bạn tham khảo nội dung trong sheet "The" ở file gửi kèm và giúp đỡ tôi nhé.