Add-In dùng để Highlight dòng, cột

[ndu96081631]

Tôi chợt nghĩ ra được 1 code có thể dùng để Highlight dòng hoặc cột, dựa trên nền tảng Conditional Formating
Code như sau:

Public Sub Highlight(SrcRng As Range, iColor As Long, Optional iType As Long = 1)
  Dim TmpRng As Range, rRng As Range, cRng As Range
  On Error Resume Next
  Set rRng = ActiveCell.EntireRow
  Set cRng = ActiveCell.EntireColumn
  Cells.FormatConditions.Delete
  Select Case iType
    Case 1: Set TmpRng = Intersect(SrcRng.Cells, rRng)
    Case 2: Set TmpRng = Intersect(SrcRng.Cells, cRng)
    Case 3: Set TmpRng = Intersect(SrcRng.Cells, Union(rRng, cRng))
    Case 4: Set TmpRng = Intersect(Range(SrcRng.Cells(1, 1), ActiveCell), Union(rRng, cRng))
  End Select
  If Application.CutCopyMode = False Then
    TmpRng.FormatConditions.Add 2, , "TRUE"
    TmpRng.FormatConditions(1).Interior.ColorIndex = iColor
  End If
End Sub

Đây là code chính! Để có thể Hightlight dòng, cột tại sheet1, các bạn viết thêm 1 code cho sheet như sau:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect([B3:M30], Target) Is Nothing Then
    Highlight [B3:M30], 5, 1 '<--- đổi số này từ 1 đến 4 để cho ra 4 kiểu HighLight
  End If
End Sub

Ưu điểm của code:
- Đơn giản và đáp ứng nhanh
- Không ảnh hưởng đến các màu sắc do ta tô sẳn trước đó
- Có 4 tùy chọn Highlight
- Có thể Save file thành 1 Add-In để dùng lâu dài (xóa code SelectionChange, chừa lại Module trước khi lưu)
Nhược điểm:
- Trên vùng hoạt động của code, ta không thể thêm bất kỳ điều kiện tô màu nào khác
---------------------------------------------
Các bạn xem file và góp ý hoàn thiện code nhé

 

[vonguyen3745]

Tôi chợt nghĩ ra được 1 code có thể dùng để Highlight dòng hoặc cột, dựa trên nền tảng Conditional Formating
Code như sau:

Public Sub Highlight(SrcRng As Range, iColor As Long, Optional iType As Long = 1)
  Dim TmpRng As Range, rRng As Range, cRng As Range
  On Error Resume Next
  Set rRng = ActiveCell.EntireRow
  Set cRng = ActiveCell.EntireColumn
  Cells.FormatConditions.Delete
  Select Case iType
    Case 1: Set TmpRng = Intersect(SrcRng.Cells, rRng)
    Case 2: Set TmpRng = Intersect(SrcRng.Cells, cRng)
    Case 3: Set TmpRng = Intersect(SrcRng.Cells, Union(rRng, cRng))
    Case 4: Set TmpRng = Intersect(Range(SrcRng.Cells(1, 1), ActiveCell), Union(rRng, cRng))
  End Select
  If Application.CutCopyMode = False Then
    TmpRng.FormatConditions.Add 2, , "TRUE"
    TmpRng.FormatConditions(1).Interior.ColorIndex = iColor
  End If
End Sub

Đây là code chính! Để có thể Hightlight dòng, cột tại sheet1, các bạn viết thêm 1 code cho sheet như sau:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect([B3:M30], Target) Is Nothing Then
    Highlight [B3:M30], 5, 1 '<--- đổi số này từ 1 đến 4 để cho ra 4 kiểu HighLight
  End If
End Sub

Ưu điểm của code:
- Đơn giản và đáp ứng nhanh
- Không ảnh hưởng đến các màu sắc do ta tô sẳn trước đó
- Có 4 tùy chọn Highlight
- Có thể Save file thành 1 Add-In để dùng lâu dài (xóa code SelectionChange, chừa lại Module trước khi lưu)
Nhược điểm:
- Trên vùng hoạt động của code, ta không thể thêm bất kỳ điều kiện tô màu nào khác
---------------------------------------------
Các bạn xem file và góp ý hoàn thiện code nhé

Sau khi tôi dùng add in "CF" của bạn thì chẳng biết sử dụng thế nào cả, Bạn có thể hướng dẫn qua cách dùng không.

 

[ndu96081631]

Sau khi tôi dùng add in "CF" của bạn thì chẳng biết sử dụng thế nào cả, Bạn có thể hướng dẫn qua cách dùng không.

Làm như sau:
- Trong cửa số lập trình, vào menu Tools\References và làm như hình:





































- Tiếp theo chỉ việc chèn đoạn code tô màu vào bất cứ sheet nào bạn muốn Highlight

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect([B3:M30], Target) Is Nothing Then
    Highlight [B3:M30], 5, 1 
  End If
End Sub

Lưu ý:
- Thay [B3:M30] thành vùng nào đó tùy ý
- Số 5 chỉ thị màu sắc, thay thành số khác tùy ý
- Số 1 chỉ thị kiểu Highlight, thay số từ 1 đến 4 tùy ý
-----------------
Đây là AddIn dùng trong VBA, mục đích để đơn giản hóa quá trình viết code tô màu
-----------------
Ý tưởng phát triển tiếp theo:
- Tạo 1 Menu hoặc Toolbars để khi cần Highlight, ta chỉ việc gọi menu này rồi điền các thông số vào là có thể thực thi ngay!
Tuy là nghĩ như vậy nhưng tôi vẫn chưa có hướng để làm ---> Các bạn góp 1 tay với nhé!

 

[bun_bo_hue]

Làm như sau:
- Trong cửa số lập trình, vào menu Tools\References và làm như hình:

View attachment 49367

- Tiếp theo chỉ việc chèn đoạn code tô màu vào bất cứ sheet nào bạn muốn Highlight

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect([B3:M30], Target) Is Nothing Then
    Highlight [B3:M30], 5, 1 
  End If
End Sub

Lưu ý:
- Thay [B3:M30] thành vùng nào đó tùy ý
- Số 5 chỉ thị màu sắc, thay thành số khác tùy ý
- Số 1 chỉ thị kiểu Highlight, thay số từ 1 đến 4 tùy ý
-----------------
Đây là AddIn dùng trong VBA, mục đích để đơn giản hóa quá trình viết code tô màu
-----------------
Ý tưởng phát triển tiếp theo:
- Tạo 1 Menu hoặc Toolbars để khi cần Highlight, ta chỉ việc gọi menu này rồi điền các thông số vào là có thể thực thi ngay!
Tuy là nghĩ như vậy nhưng tôi vẫn chưa có hướng để làm ---> Các bạn góp 1 tay với nhé!

Cách của bác NDU rất hay nhưng có cái yếu điểm là khi di chuyển màn hình chớp giật dữ quá, nếu file dữ liệu lớn (khỏang 20MB - như file em đang dùng) thì dùng cách này không ổn.

 

[ndu96081631]

Cách của bác NDU rất hay nhưng có cái yếu điểm là khi di chuyển màn hình chớp giật dữ quá, nếu file dữ liệu lớn (khỏang 20MB - như file em đang dùng) thì dùng cách này không ổn.

Nhờ các bạn khác test giúp tiếp... Vì tôi thí nghiệm trên máy tôi lại không thấy hiện tượng chớp giật như bạn vừa nói
(Mà file Excel gì mà đến 20M quá cở vậy trời! Tôi nghĩ file của bạn dù không có AddIn này thì tự thân nó cũng đã ì ạch rồi còn gì)

 

[rollover79]

Code này tuy không ảnh hưởng đến các màu sắc do ta tô sẵn trước đó, nhưng nó xoá hết tất cả các CF kể cả những vùng mà nó không tác động tới. Còn 1 vấn đề nữa có thể tối ưu, đó là kiểm tra nếu vùng tác động không thay đổi thì không cần phải thực hiện, ví dụ trường hợp tô màu trên dòng, nếu tôi di chuyển trên cùng 1 dòng thì không cần thực hiện làm gì cho mất công, khi nào tôi di chuyển ra khỏi dòng đó thì mới cần thực hiện.

 

[ndu96081631]

Code này tuy không ảnh hưởng đến các màu sắc do ta tô sẵn trước đó, nhưng nó xoá hết tất cả các CF kể cả những vùng mà nó không tác động tới. Còn 1 vấn đề nữa có thể tối ưu, đó là kiểm tra nếu vùng tác động không thay đổi thì không cần phải thực hiện, ví dụ trường hợp tô màu trên dòng, nếu tôi di chuyển trên cùng 1 dòng thì không cần thực hiện làm gì cho mất công, khi nào tôi di chuyển ra khỏi dòng đó thì mới cần thực hiện.

Cái này cũng hơi khó, vì có đến 4 kiểu Highlight khác nhau bạn à! Dù sửa thì cũng chỉ áp dụng được cho Case 1 và Case 2 mà thôi!
Mặc khác: Vì dùng Conditional Formating nên mình cũng chẳng biết làm cách nào để giữ lại điều kiện tô màu cũ
--------------------------------
Cái mình đang băn khoăn ở đây là bước phát triển tiếp theo: Làm 1 nút trên ToolBars để khi cần sẽ gọi và thực thi ngay (khỏi cần viết code SelectionChange)
Áng chừng có thể phải động đến ClassModule ???
Bạn có rảnh hãy giúp 1 tay với

 

[Nguyễn Duy Tuân]

Các bác thử chạy cái GridHighlighter – Add-Ins Trợ giúp bảng tính Excel xem thế nào?
http://www.giaiphapexcel.com/forum/...ighLighter-–-Add-Ins-Trợ-giúp-bảng-tính-Excel

Cái GridHighlighter làm lâu lắm rồi.

 

[ndu96081631]

Các bác thử chạy cái GridHighlighter – Add-Ins Trợ giúp bảng tính Excel xem thế nào?
http://www.giaiphapexcel.com/forum/...ighLighter-–-Add-Ins-Trợ-giúp-bảng-tính-Excel

Cái GridHighlighter làm lâu lắm rồi.

Cái của Tuân mình đã biết lâu rồi (có thử, rất ngon)... nhưng ở đây dùng giải thuật khác mà Tuân (đơn giản, dành cho người mới học)

 

[Nguyễn Duy Tuân]

Cái của Tuân mình đã biết lâu rồi (có thử, rất ngon)... nhưng ở đây dùng giải thuật khác mà Tuân (đơn giản, dành cho người mới học)

Chắc anh đang khai thác tối đa chức năng Conditional Formatting? Cái này có ảnh hưởng tới định của người dùng khi in. Vậy trước khi in (BeforPrint) anh tạm ngắt hoặc xoá công thức, khi in xong thì lại chạy công thức?

 

[bun_bo_hue]

Nhờ các bạn khác test giúp tiếp... Vì tôi thí nghiệm trên máy tôi lại không thấy hiện tượng chớp giật như bạn vừa nói
(Mà file Excel gì mà đến 20M quá cở vậy trời! Tôi nghĩ file của bạn dù không có AddIn này thì tự thân nó cũng đã ì ạch rồi còn gì)

File dữ liệu em thường sử dụng trong công việc hàng ngày (dao động từ 16MB -> 25MB) , em vẫn làm hightight giống như pác như là viết macro (xài rất nhanh, kô bị giật) nhưng có 1 điểm yếu là bị mất màu cell (nếu có tô).

 

[newhope2005]

Ý tưởng phát triển tiếp theo:
- Tạo 1 Menu hoặc Toolbars để khi cần Highlight, ta chỉ việc gọi menu này rồi điền các thông số vào là có thể thực thi ngay!
Tuy là nghĩ như vậy nhưng tôi vẫn chưa có hướng để làm ---> Các bạn góp 1 tay với nhé!

Bác NDU ơi. Nếu có được cái theo ý tưởng của bác thì tốt quá.
Bác giúp em với được không?
cám ơn bác

 

[nguyetsinh]

Tôi thấy cách này cũng khá hay mời anh em tham khảo tại link này
http://www.excel-easy.com/vba/examples/highlight-active-cell.html

 

[Nguyễn Duy Tuân]

Tôi thấy cách này cũng khá hay mời anh em tham khảo tại link này
http://www.excel-easy.com/vba/examples/highlight-active-cell.html

Một bảng tính được định dạng đầy đủ cho việc in. Vậy khi highlight với mầu sắc như vậy thì ínex thế nào?

 

[Excel365]

Tôi chợt nghĩ ra được 1 code có thể dùng để Highlight dòng hoặc cột, dựa trên nền tảng Conditional Formating
Code như sau:

Public Sub Highlight(SrcRng As Range, iColor As Long, Optional iType As Long = 1)
  Dim TmpRng As Range, rRng As Range, cRng As Range
  On Error Resume Next
  Set rRng = ActiveCell.EntireRow
  Set cRng = ActiveCell.EntireColumn
  Cells.FormatConditions.Delete
  Select Case iType
    Case 1: Set TmpRng = Intersect(SrcRng.Cells, rRng)
    Case 2: Set TmpRng = Intersect(SrcRng.Cells, cRng)
    Case 3: Set TmpRng = Intersect(SrcRng.Cells, Union(rRng, cRng))
    Case 4: Set TmpRng = Intersect(Range(SrcRng.Cells(1, 1), ActiveCell), Union(rRng, cRng))
  End Select
  If Application.CutCopyMode = False Then
    TmpRng.FormatConditions.Add 2, , "TRUE"
    TmpRng.FormatConditions(1).Interior.ColorIndex = iColor
  End If
End Sub

Đây là code chính! Để có thể Hightlight dòng, cột tại sheet1, các bạn viết thêm 1 code cho sheet như sau:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect([B3:M30], Target) Is Nothing Then
    Highlight [B3:M30], 5, 1 '<--- đổi số này từ 1 đến 4 để cho ra 4 kiểu HighLight
  End If
End Sub

Ưu điểm của code:
- Đơn giản và đáp ứng nhanh
- Không ảnh hưởng đến các màu sắc do ta tô sẳn trước đó
- Có 4 tùy chọn Highlight
- Có thể Save file thành 1 Add-In để dùng lâu dài (xóa code SelectionChange, chừa lại Module trước khi lưu)
Nhược điểm:
- Trên vùng hoạt động của code, ta không thể thêm bất kỳ điều kiện tô màu nào khác
---------------------------------------------
Các bạn xem file và góp ý hoàn thiện code nhé

Thày Ndu cho em hỏi làm sao để khi in ra giấy thì không thấy màu do hightlight tô vây thầy

 

[ndu96081631]

Thày Ndu cho em hỏi làm sao để khi in ra giấy thì không thấy màu do hightlight tô vây thầy

Chú ý đoạn code này:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect([B3:M30], Target) Is Nothing Then
    Highlight [B3:M30], 5, 1 '<--- đổi số này từ 1 đến 4 để cho ra 4 kiểu HighLight
  End If
End Sub

Sửa thành:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  
    Highlight [B3:M30], 5, 1 '<--- đổi số này từ 1 đến 4 để cho ra 4 kiểu HighLight

End Sub

Khi muốn in, hay dời chuột lên trên dòng 3 hoặc dưới dòng 30 là được

 

[Excel365]

Chú ý đoạn code này:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect([B3:M30], Target) Is Nothing Then
    Highlight [B3:M30], 5, 1 '<--- đổi số này từ 1 đến 4 để cho ra 4 kiểu HighLight
  End If
End Sub

Sửa thành:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  
    Highlight [B3:M30], 5, 1 '<--- đổi số này từ 1 đến 4 để cho ra 4 kiểu HighLight

End Sub

Khi muốn in, hay dời chuột lên trên dòng 3 hoặc dưới dòng 30 là được

Tuyệt vời. Cám ơn thầy nhiều

 

[Excel365]

Chú ý đoạn code này:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect([B3:M30], Target) Is Nothing Then
    Highlight [B3:M30], 5, 1 '<--- đổi số này từ 1 đến 4 để cho ra 4 kiểu HighLight
  End If
End Sub

Sửa thành:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  
    Highlight [B3:M30], 5, 1 '<--- đổi số này từ 1 đến 4 để cho ra 4 kiểu HighLight

End Sub

Khi muốn in, hay dời chuột lên trên dòng 3 hoặc dưới dòng 30 là được

Thầy cho em hỏi, khi em chỉnh thành

Highlight [B3:M30], 5, 4

khi em di chuyển chuột ra khỏi vùng [B3:B30] thi khi in vẫn thấy màu hightlight

 

[ndu96081631]

Thầy cho em hỏi, khi em chỉnh thành

Highlight [B3:M30], 5, 4

khi em di chuyển chuột ra khỏi vùng [B3:B30] thi khi in vẫn thấy màu hightlight

Viết lâu lắm rồi, cũng chẳng để ý nữa
Giờ bạn sửa code trong Module thành vầy nhé:

Public Sub Highlight(SrcRng As Range, [COLOR=#ff0000]Target As Range[/COLOR], iColor As Long, Optional iType As Long = 1)
  Dim TmpRng As Range
  On Error Resume Next
  Cells.FormatConditions.Delete
  If Not Intersect(SrcRng, Target) Is Nothing Then
    With SrcRng
      Select Case iType
        Case 1:
          Set TmpRng = Intersect(.Cells, Target.EntireRow)
        Case 2:
          Set TmpRng = Intersect(.Cells, Target.EntireColumn)
        Case 3:
          Set TmpRng = Intersect(.Cells, Union(Target.EntireColumn, Target.EntireRow))
        Case 4:
          Set TmpRng = Intersect(Range(.Cells(1, 1), Target), Union(Target.EntireColumn, Target.EntireRow))
      End Select
    End With
    If Application.CutCopyMode = False Then
      TmpRng.FormatConditions.Add 2, , "TRUE"
      TmpRng.FormatConditions(1).Interior.ColorIndex = iColor
    End If
  End If
End Sub

Còn code sự kiện SelectionChange thì sửa thành:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Highlight [B3:M30], [COLOR=#ff0000]Target[/COLOR], 5, 3
End Sub

Code mới có thêm đối số Target

 

[beo87]

Các anh em cho em hỏi vấn đề này với: Khi tick vào Checkbox để highlight dòng hoặc cột thì nó hoạt động trên các sheets của file này (đính kèm). Nhưng khi lưu nó thành addin thì lại không hoạt động trên các file khác. Vậy để nó hoạt động được trên các file khác thì cần điều chỉnh code như thế nào ạ? Mong các anh giúp với. Em xin cảm ơn!