Code vba Đóng khung cột khi chọn ô (1 người xem)

BoKuDo · 11/8/17

Nhờ các bạn giúp mình 1 đoạn code có chức năng đóng khung cột (Chỉ 2 đường dọc cột) khi chọn vào 1 ô.
Ví dụ:
- Khi mình kích vào ô AO9 thì cột từ AO10 trở xuống sẽ được đóng khung (2 đường chạy dọc) giống như bên trên. Và khi kích vào ô khác như AF9 thì cột từ AF10 trở xuống sẽ được đóng khung (2 đường chạy dọc) và 2 đường chạy dọc ở AO10 trở xuống không xuất hiện nữa.
- Tương tự khi kích vào các ô khác từ AC9 trở về sau.
- Các đường chạy dọc cột này sẽ chạy đến hết dòng chứa nội dung ở cột G.
Mình có đính kèm file bên dưới.
Mình cảm ơn!

ndu96081631 · 11/8/17

BoKuDo đã viết:
Nhờ các bạn giúp mình 1 đoạn code có chức năng đóng khung cột (Chỉ 2 đường dọc cột) khi chọn vào 1 ô.
Ví dụ:
- Khi mình kích vào ô AO9 thì cột từ AO10 trở xuống sẽ được đóng khung (2 đường chạy dọc) giống như bên trên. Và khi kích vào ô khác như AF9 thì cột từ AF10 trở xuống sẽ được đóng khung (2 đường chạy dọc) và 2 đường chạy dọc ở AO10 trở xuống không xuất hiện nữa.
- Tương tự khi kích vào các ô khác từ AC9 trở về sau.
- Các đường chạy dọc cột này sẽ chạy đến hết dòng chứa nội dung ở cột G.
Mình có đính kèm file bên dưới.
Mình cảm ơn!

Mục đích để làm gì vậy bạn?
Và nếu click nhầm thì phải làm sao?

BoKuDo · 11/8/17

ndu96081631 đã viết:
Mục đích để làm gì vậy bạn?
Và nếu click nhầm thì phải làm sao?

Mục đích là để dễ theo dõi nội dung các ô trong cột đó. Và chỉ có tác dụng từ ô AC9 trở về sau thôi anh à.
Khi trong file có nhiều dòng, muốn lăn con trỏ xuống dưới vẫn dễ xem hơn. Cũng giống như tô màu cột vạy, tuy nhiên tô màu thì sẽ ảnh hưởng đến các màu khác trong bảng nên em mới nghĩ ra đóng khung kiểu này.

befaint · 11/8/17

BoKuDo đã viết:
Mục đích là để dễ theo dõi nội dung các ô trong cột đó. Và chỉ có tác dụng từ ô AC9 trở về sau thôi anh à.
Khi trong file có nhiều dòng, muốn lăn con trỏ xuống dưới vẫn dễ xem hơn. Cũng giống như tô màu cột vạy, tuy nhiên tô màu thì sẽ ảnh hưởng đến các màu khác trong bảng nên em mới nghĩ ra đóng khung kiểu này.

Tìm code "xịn" về hight light thử xem (không làm thay đổi màu đã tô)...
Hoặc dùng định dạng kiểu Table cho đơn giản.

ndu96081631 · 11/8/17

BoKuDo đã viết:
tuy nhiên tô màu thì sẽ ảnh hưởng đến các màu khác trong bảng nên em mới nghĩ ra đóng khung kiểu này.

Vậy đóng khung thì không ảnh hưởng đến những chỗ đã đóng khung khác à?

BoKuDo · 11/8/17

befaint đã viết:
Tìm code "xịn" về hight light thử xem (không làm thay đổi màu đã tô)...
Hoặc dùng định dạng kiểu Table cho đơn giản.

Code hight light thì kích bất kỳ ô nào cũng tô màu, còn em chỉ muốn kích từ AC9 trở đi thôi, ngoài ra không có tác dụng nữa.
Với lại kẻ 2 đường dọc này sẽ dễ chịu hơn khi sử dụng, kiểm tra.
Còn phần định dạng kiểu Table thì e thử record macro nó cho ra cả rừng như bên dưới, e chưa biết tùy biến code

Mã:

Sub Macro1()
'
' Macro1 Macro
'

'
    Range("AT10:AT13").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("AT10:AT13").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("AY10:AY13").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
End Sub

befaint · 11/8/17

BoKuDo đã viết:
định dạng kiểu Table

Không dùng code gì cả, cái đó nó tô màu nền 2 dòng liên tiếp khác nhau để dễ nhìn.
Cách làm:
- Chọn vùng dữ liệu cần định dạng.
- Nhấn Ctrl + T, nhấn Enter.
Kết thúc!

ndu96081631 · 11/8/17

BoKuDo đã viết:

Code hight light thì kích bất kỳ ô nào cũng tô màu, còn em chỉ muốn kích từ AC9 trở đi thôi, ngoài ra không có tác dụng nữa.
Với lại kẻ 2 đường dọc này sẽ dễ chịu hơn khi sử dụng, kiểm tra.
Còn phần định dạng kiểu Table thì e thử record macro nó cho ra cả rừng như bên dưới, e chưa biết tùy biến code

Mã:

Sub Macro1()
'
' Macro1 Macro
'

'
    Range("AT10:AT13").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("AT10:AT13").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("AY10:AY13").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
End Sub

Ai làm thế!
Thử code này nhé:
1> Code trong module:

Mã:

Public Sub Highlight(SrcRng As Range, Target As Range, iColor As Long, Optional iType As Long = 1)
  Dim TmpRng As Range
  On Error Resume Next
  Cells.FormatConditions.Delete
  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 Sub

2> Code sự kiện SelectionChange trong sheet1:

Mã:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect([AC9:BL13], Target) Is Nothing Then
    Highlight [AC9:BL13], Target, 6, 2
  End If
End Sub

Số 6: màu sắc (thay đổi từ 1 đến 56
Số 2: kiểu tô màu. Có 4 kiểu từ 1 đến 4. Bạn tự thay đổi và tùy chọn cái nào thích hợp

be_09 · 11/8/17

Góp thêm 1 code cho vui, khi click vào 1 cell nào thì nó tô màu xanh biển từ Cell chọn đến dòng 9 (ngoại trừ dòng 1 đến dòng 8 không tô).

Mã:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Dong, Cot, i As Integer

    Cells.Interior.ColorIndex = 0
    Dong = ActiveCell.Row
    Cot = ActiveCell.Column
   
    For i = 1 To Dong
        Cells(i, Cot).Interior.ColorIndex = 37
    Next i
    Range("A1:AA8").Interior.ColorIndex = xlNone
End Sub

BoKuDo · 11/8/17

ndu96081631 đã viết:
Ai làm thế!
Thử code này nhé:

2> Code sự kiện SelectionChange trong sheet1:

Mã:

Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect([AC9:BL13], Target) Is Nothing Then Highlight [AC9:BL13], Target, 6, 2 End If End Sub

Em cảm ơn, cũng gần với ý đồ rồi anh ơi, thích nhất là ko xóa tô màu cũ

Tuy nhiên phần bảng tính [AC9:BL13] là không cố định anh ơi. Bảng tính có thể nhiều dòng nhiều cột hơn, nên phạm vi hoạt động của cột high light sẽ phụ thuộc vào nội dung từ cột G10 trở xuống, và dòng AC9 trở đi (Nếu có)
Anh giúp với!

phulien1902 · 11/8/17

BoKuDo đã viết:
Em cảm ơn, cũng gần với ý đồ rồi anh ơi, thích nhất là ko xóa tô màu cũ
Tuy nhiên phần bảng tính [AC9:BL13] là không cố định anh ơi. Bảng tính có thể nhiều dòng nhiều cột hơn, nên phạm vi hoạt động của cột high light sẽ phụ thuộc vào nội dung từ cột G10 trở xuống, và dòng AC9 trở đi (Nếu có)
Anh giúp với!

Bạn muốn không xóa màu cũ, thì bỏ dòng dưới đi:

PHP:

Cells.FormatConditions.Delete

huuthang_bd · 11/8/17

phulien1902 đã viết:
Bạn muốn không xóa màu cũ, thì bỏ dòng dưới đi:

PHP:

Cells.FormatConditions.Delete

Ý người ta là thích vì code đã không xóa màu cũ (người dùng tự tô).

P/S: Nhưng mà tô bằng CF là bị xóa đó nha chủ topic.

BoKuDo · 12/8/17

BoKuDo đã viết:
Em cảm ơn, cũng gần với ý đồ rồi anh ơi, thích nhất là ko xóa tô màu cũ
Tuy nhiên phần bảng tính [AC9:BL13] là không cố định anh ơi. Bảng tính có thể nhiều dòng nhiều cột hơn, nên phạm vi hoạt động của cột high light sẽ phụ thuộc vào nội dung từ cột G10 trở xuống, và dòng AC9 trở đi (Nếu có)
Anh giúp với!

Còn phần này nhờ anh ndu hoặc anh/bạn nào biết giúp mình với.
Mình cảm ơn!

Ba Tê · 12/8/17

BoKuDo đã viết:
Em cảm ơn, cũng gần với ý đồ rồi anh ơi, thích nhất là ko xóa tô màu cũ
Tuy nhiên phần bảng tính [AC9:BL13] là không cố định anh ơi. Bảng tính có thể nhiều dòng nhiều cột hơn, nên phạm vi hoạt động của cột high light sẽ phụ thuộc vào nội dung từ cột G10 trở xuống, và dòng AC9 trở đi (Nếu có)
Anh giúp với!

Xem thử file này với Conditional Formatting bằng VBA.
Tô màu cho dễ xem chứ kẻ 2 sọc khó nhìn quá.

BoKuDo · 12/8/17

Ba Tê đã viết:
Xem thử file này với Conditional Formatting bằng VBA.
Tô màu cho dễ xem chứ kẻ 2 sọc khó nhìn quá.

Đúng ý em rồi, cảm ơn anh nhiều!

ndu96081631 · 12/8/17

BoKuDo đã viết:
Còn phần này nhờ anh ndu hoặc anh/bạn nào biết giúp mình với.
Mình cảm ơn!

Ủa! Phần dữ liệu thì tự bạn phải xác định chứ. Xác định xong cứ truyền vào hàm thôi. Ví dụ"

Mã:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim rng As Range
  Set rng = Range(Range("AC" & Range("G60000").End(xlUp).Row), Range("IV9").End(xlToLeft))
 
  If Not Intersect(rng, Target) Is Nothing Then
    Highlight rng, Target, 6, 2 
  End If
End Sub

thêm công đoạn xác định vùng dữ liệu động

BoKuDo · 13/8/17

Cảm ơn anh ndu và các anh đã hỗ trợ, code hoạt động rất ổn ạ.
Em có một ý là nếu như vẫn code này mà em muốn chuyển thành add-ins để có thể sử dụng bất cứ lúc nào vào các việc khác nhau thì phải code trong form thế nào vậy? Em có tạo 1 form như file đính kèm mà ko biết code thế nào để có thể sử dụng như 1 add-ins được (trong form có phần bật/tắt high light).
Các anh có thể giúp em được không?
Em cảm ơn!

giaiphap · 13/8/17

BoKuDo đã viết:
Cảm ơn anh ndu và các anh đã hỗ trợ, code hoạt động rất ổn ạ.
Em có một ý là nếu như vẫn code này mà em muốn chuyển thành add-ins để có thể sử dụng bất cứ lúc nào vào các việc khác nhau thì phải code trong form thế nào vậy? Em có tạo 1 form như file đính kèm mà ko biết code thế nào để có thể sử dụng như 1 add-ins được (trong form có phần bật/tắt high light).
Các anh có thể giúp em được không?
Em cảm ơn!

Bạn xem thử cái này có cải biến lại được gì không cho nhu cầu của bạn.
http://www.giaiphapexcel.com/diendan/threads/chia-sẻ-add-ins-gridhighlighter-open-source.117578/

ndu96081631 · 13/8/17

BoKuDo đã viết:
Cảm ơn anh ndu và các anh đã hỗ trợ, code hoạt động rất ổn ạ.
Em có một ý là nếu như vẫn code này mà em muốn chuyển thành add-ins để có thể sử dụng bất cứ lúc nào vào các việc khác nhau thì phải code trong form thế nào vậy? Em có tạo 1 form như file đính kèm mà ko biết code thế nào để có thể sử dụng như 1 add-ins được (trong form có phần bật/tắt high light).
Các anh có thể giúp em được không?
Em cảm ơn!

Thật ra tôi đã có ý tưởng tạo Addin này từ lâu, thiết kế cũng đã làm rồi:

nhưng rồi lại để đó vì không có thời gian
(tính tôi nếu không làm thì thôi, nếu đã làm thì sản phẩm phải hoàn hảo, người dùng thấy thuận tiện nhất khi sử dụng)

BoKuDo · 13/8/17

ndu96081631 đã viết:
Thật ra tôi đã có ý tưởng tạo Addin này từ lâu, thiết kế cũng đã làm rồi:

View attachment 181495

nhưng rồi lại để đó vì không có thời gian
(tính tôi nếu không làm thì thôi, nếu đã làm thì sản phẩm phải hoàn hảo, người dùng thấy thuận tiện nhất khi sử dụng)

Tiếc quá, hy vọng sẽ có cơ hội sử dụng sớm.

Code vba Đóng khung cột khi chọn ô (1 người xem)

Người dùng đang xem chủ đề này

Thành viên chính thức

File đính kèm

Huyền thoại GPE

Thành viên chính thức

|||||||||||||

Huyền thoại GPE

Thành viên chính thức

|||||||||||||

Huyền thoại GPE

File đính kèm

Biên Hòa, Đồng Nai

Thành viên chính thức

GPE - My love

Chuyên gia GPE

Thành viên chính thức

Cạo Rồi Khỏi Gội

File đính kèm

Thành viên chính thức

Huyền thoại GPE

Thành viên chính thức

File đính kèm

==(^o^)==

Huyền thoại GPE

Thành viên chính thức

Đếm ngược thời gian