Tô màu bằng VBA theo bảng mã quy định (1 người xem)

[stao]

Chào các Bác,

Mình có thông tin file như sau:
- Sheet DT: mã quy định code nào màu nào.
- Sheet RS: tô màu B5:G8 theo quy định ở Sheet DT, không phân biệt chữ hoa chữ thường.

Mình đã làm theo macro nhưng dài quá vì nhiều mã cần tô màu và danh mục mã này lại không cố định.
Nhờ các Bác giúp mình code VBA tổng quát theo vòng lặp.

Cảm ơn nhiều.

 

[ndu96081631]

Chào các Bác,

Mình có thông tin file như sau:
- Sheet DT: mã quy định code nào màu nào.
- Sheet RS: tô màu B5:G8 theo quy định ở Sheet DT, không phân biệt chữ hoa chữ thường.

Mình đã làm theo macro nhưng dài quá vì nhiều mã cần tô màu và danh mục mã này lại không cố định.
Nhờ các Bác giúp mình code VBA tổng quát theo vòng lặp.

Cảm ơn nhiều.

Chỉ có 5 màu ta dùng Conditional Formating cho nhanh bạn à

 

[stao]

Chỉ có 5 màu ta dùng Conditional Formating cho nhanh bạn à

Dữ liệu thực tế nhiều màu và trên 10.000 dòng nên muốn dùng VBA để On/Off cho nó nhẹ file Bác.

 

[ndu96081631]

Dữ liệu thực tế nhiều màu và trên 10.000 dòng nên muốn dùng VBA để On/Off cho nó nhẹ file Bác.

Nếu quá nhiều màu thì... KHÔNG NÊN TÔ, bởi đó sẽ là lý do khiến file bạn chậm.
Suy nghĩ cách quản lý khác đi

 

[stao]

Nếu quá nhiều màu thì... KHÔNG NÊN TÔ, bởi đó sẽ là lý do khiến file bạn chậm.
Suy nghĩ cách quản lý khác đi

Vấn đề là không còn cách khác nên mới đau đầu đó Bác

 

[be_09]

Chào các Bác,

Mình có thông tin file như sau:
- Sheet DT: mã quy định code nào màu nào.
- Sheet RS: tô màu B5:G8 theo quy định ở Sheet DT, không phân biệt chữ hoa chữ thường.

Mình đã làm theo macro nhưng dài quá vì nhiều mã cần tô màu và danh mục mã này lại không cố định.
Nhờ các Bác giúp mình code VBA tổng quát theo vòng lặp.

Cảm ơn nhiều.

Tại sheet DT, tôi tạo sẳn cho bạn bảng màu (56 màu), nhưng chỉ chừa lại màu sáng, còn những màu tối tôi đã xóa (vì khó nhìn).
Cho mã ký tự của bạn vào cột A, để dựa vào đó mà giúp cho bạn sẽ dễ dàng hơn.

 

[HieuCD]

Chào các Bác,

Mình có thông tin file như sau:
- Sheet DT: mã quy định code nào màu nào.
- Sheet RS: tô màu B5:G8 theo quy định ở Sheet DT, không phân biệt chữ hoa chữ thường.

Mình đã làm theo macro nhưng dài quá vì nhiều mã cần tô màu và danh mục mã này lại không cố định.
Nhờ các Bác giúp mình code VBA tổng quát theo vòng lặp.

Cảm ơn nhiều.

Sub HoaSy_Voi()
  Dim cArr(), sArr(), Res() As Range
  Dim i As Long, k As Long, j As Byte
  cArr = Sheets("DT").Range("A2", Sheets("DT").Range("B65500").End(xlUp)).Value
  ReDim Res(1 To UBound(cArr))
  sArr = Sheets("RS").Range("A1:G8").Value
  
  With CreateObject("scripting.dictionary")
    For i = 1 To UBound(cArr)
      .Item(cArr(i, 1)) = i
    Next i
    For i = 5 To 8
      For j = 2 To 7
        k = .Item(UCase(sArr(i, j)))
        If k Then
          If Res(k) Is Nothing Then
            Set Res(k) = Cells(i, j)
          Else
            Set Res(k) = Union(Res(k), Cells(i, j))
          End If
        End If
      Next j
    Next i
  End With
  For i = 1 To UBound(cArr)
    If Not Res(i) Is Nothing Then Res(i).Interior.Color = cArr(i, 2)
  Next i
End Sub

 

[stao]

Tại sheet DT, tôi tạo sẳn cho bạn bảng màu (56 màu), nhưng chỉ chừa lại màu sáng, còn những màu tối tôi đã xóa (vì khó nhìn).
Cho mã ký tự của bạn vào cột A, để dựa vào đó mà giúp cho bạn sẽ dễ dàng hơn.

Gửi Bác file nhập các mã tương ứng màu

 

[stao]

Sub HoaSy_Voi()
  Dim cArr(), sArr(), Res() As Range
  Dim i As Long, k As Long, j As Byte
  cArr = Sheets("DT").Range("A2", Sheets("DT").Range("B65500").End(xlUp)).Value
  ReDim Res(1 To UBound(cArr))
  sArr = Sheets("RS").Range("A1:G8").Value
 
  With CreateObject("scripting.dictionary")
    For i = 1 To UBound(cArr)
      .Item(cArr(i, 1)) = i
    Next i
    For i = 5 To 8
      For j = 2 To 7
        k = .Item(UCase(sArr(i, j)))
        If k Then
          If Res(k) Is Nothing Then
            Set Res(k) = Cells(i, j)
          Else
            Set Res(k) = Union(Res(k), Cells(i, j))
          End If
        End If
      Next j
    Next i
  End With
  For i = 1 To UBound(cArr)
    If Not Res(i) Is Nothing Then Res(i).Interior.Color = cArr(i, 2)
  Next i
End Sub

Cảm ơn Bác. Cách này hay nè.
Khi ráp vào dữ liệu lớn thì đứng máy luôn. Không rõ mình có làm sai ở đâu không? Vì chỉ sửa i, j tương ứng với vùng dữ liệu cần tô màu.

 

[be_09]

Cảm ơn Bác. Cách này hay nè.
Khi ráp vào dữ liệu lớn thì đứng máy luôn. Không rõ mình có làm sai ở đâu không? Vì chỉ sửa i, j tương ứng với vùng dữ liệu cần tô màu.

Lớn là đến bao nhiêu dòng?

 

[HieuCD]

Cảm ơn Bác. Cách này hay nè.
Khi ráp vào dữ liệu lớn thì đứng máy luôn. Không rõ mình có làm sai ở đâu không? Vì chỉ sửa i, j tương ứng với vùng dữ liệu cần tô màu.

Dùng code sau

Sub HoaSy_Voi()
  Dim cArr(), sArr(), Res() As Range, Rng As Range
  Dim i As Long, k As Long, j As Byte
  Application.ScreenUpdating = False
  cArr = Sheets("DT").Range("A2", Sheets("DT").Range("B65500").End(xlUp)).Value
  ReDim Res(1 To UBound(cArr))
  sArr = Sheets("RS").Range("A1:G8").Value
  With CreateObject("scripting.dictionary")
    For i = 1 To UBound(cArr)
      .Item(cArr(i, 1)) = i
    Next i
    For i = 5 To UBound(sArr)
      For j = 2 To 7
        k = .Item(UCase(sArr(i, j)))
        If k Then
          If Res(k) Is Nothing Then
            Set Res(k) = Cells(i, j)
          Else
            Set Res(k) = Union(Res(k), Cells(i, j))
            If Res(k).Cells.Count = 20 Then
              Res(k).Interior.Color = cArr(k, 2)
              Set Res(k) = Nothing
            End If
          End If
        End If
      Next j
    Next i
  End With
  For i = 1 To UBound(cArr)
    If Not Res(i) Is Nothing Then Res(i).Interior.Color = cArr(i, 2)
  Next i
  Application.ScreenUpdating = True
End Sub

If Res(k).Cells.Count = 20 Then
Nếu máy mạnh có thể chỉnh số 20 lớn hơn 1 chút

 

[Hoang2013]

Dữ liệu thực tế nhiều màu và trên 10.000 dòng nên muốn dùng VBA để On/Off cho nó nhẹ file Bác.

Nhiều là bao nhiêu màu?

Bảng màu trên Excel 2010 chỉ là 50 màu thọi đó. Vượt qua số này mắt thường không dễ fân biệt!
E rằng tiền mất tật mang cũng nên.

 

[be_09]

Vấn đề là không còn cách khác nên mới đau đầu đó Bác

Thử dùng Select Case.
Khi trong vùng B5:G300 sheet RS thay đổi mã thì màu Cell hiện lên như mã của sheet DT.

 

[stao]

Cảm ơn các Bác nhiều. Em đang thử nghiệm cách các Bác với dữ liệu 10.000 dòng tới 50.000 và trên 30 màu.