儲存各取得焦點後某一欄位變色

coafort

請問各位大大
比方點了AR212欄位
AG212底色會變
要怎設計呢
謝謝

Andy2483

回復 1# coafort
工作表模組下植入:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Target
   If Replace(Split(.Address, "$")(1), ":", "") = "AR" Then
      Me.UsedRange.EntireColumn.Interior.ColorIndex = xlNone
      '↑令本表使用格的整欄底色為無色
      .Offset(, -11).Interior.ColorIndex = 6
      '↑令一開始選取格是AR欄儲存格範圍的左側11欄儲存格底色是黃色
   End If
End With
End Sub

coafort

回復  coafort
工作表模組下植入:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Targ ...
Andy2483 發表於 2024-2-1 14:23

請問大大
用了之後原來的顏色都沒了
謝謝

Andy2483

回復 3# coafort

工作表模組下植入:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Target
   If Replace(Split(.Address, "$")(1), ":", "") = "AR" Then
      .Offset(, -11).EntireColumn.Interior.ColorIndex = xlNone
      '↑令AG欄整欄底色為無色
      .Offset(, -11).Interior.ColorIndex = 6
      '↑令一開始選取格是AR欄儲存格範圍的左側11欄儲存格底色是黃色
   End If
End With
End Sub

coafort

回復  coafort



回復 1# coafort
工作表模組下植入:
Option Explicit
Private Sub Worksheet_Sel ...
Andy2483 發表於 2024-2-1 18:29

謝謝大大
請問有辦法保留原有欄的顏色嗎？

Andy2483

回復 5# coafort

工作表模組下植入:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Target
   If Replace(Split(.Address, "$")(1), ":", "") = "AR" Then
      .Offset(, -11).Interior.ColorIndex = 6
      '↑令一開始選取格是AR欄儲存格範圍的左側11欄儲存格底色是黃色
   End If
End With
End Sub

coafort

回復  coafort

工作表模組下植入:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Ta ...
Andy2483 發表於 2024-2-1 18:57

報告大大
離開後黃底不會消失耶
謝謝大大

Andy2483

回復 7# coafort


Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim a as Range
With Target
   For Each a in Intersect([AG:AG],Me.UsedRange)
      If a.interior.Colorindex=6 Then a.interior.colorindex=xlnone
   Next
   If Replace(Split(.Address, "$")(1), ":", "") = "AR" Then
      .Offset(, -11).Interior.ColorIndex = 6
      '↑令一開始選取格是AR欄儲存格範圍的左側11欄儲存格底色是黃色
   End If
End With
End Sub

quickfixer

https://stackoverflow.com/questions/58282085/change-cell-color-when-it-selected-and-back-original-color-after-leaving-it

樓主要的應該是這個功能

quickfixer

回復 9# quickfixer


    該位作者的程式碼有2個問題

程式執行中,無法修改顏色
程式開頭加入if, cc 看要不要用某個cell代替
cc = "顏色可修改"
If cc = "顏色可修改" Then Exit Sub

選取欄位會把無關的列數全部放入陣列,也不能選整個工作表,程式會lag超久
簡單加個限制,可選取的列上限100,欄上限26,這要看電腦效能修改

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Static rngcolor As Range
    Static OldColor As Variant
    Dim rw As Long, cl As Long
   
    'cc = "顏色可修改"
    If cc = "顏色可修改" Then Exit Sub
    If Target.Columns.Count > 26 Then Exit Sub
     
    If Not rngcolor Is Nothing Then
        If IsArray(OldColor) Then
            On Error GoTo NoRestore
            For rw = 1 To rngcolor.Rows.Count
                For cl = 1 To rngcolor.Columns.Count
                    If IsEmpty(OldColor(rw, cl)) Then
                        rngcolor.Cells(rw, cl).Interior.ColorIndex = xlNone
                    Else
                        rngcolor.Cells(rw, cl).Interior.Color = OldColor(rw, cl)
                    End If
                Next
            Next
            On Error GoTo 0
        Else
            If IsEmpty(OldColor) Then
                rngcolor.Interior.ColorIndex = xlNone
            Else
                rngcolor.Interior.Color = OldColor
            End If
        End If
    End If
NoRestore:
    On Error GoTo 0

   
   
    If Target.Rows.Count > 100 Then nr = 100 Else nr = Target.Rows.Count
    Set rngcolor = Target.Resize(nr)
   
   
    ReDim OldColor(1 To nr, 1 To Target.Columns.Count)
    For rw = 1 To nr
        For cl = 1 To Target.Columns.Count
            If Target.Cells(rw, cl).Interior.ColorIndex = xlNone Then
                OldColor(rw, cl) = Empty
            Else
                OldColor(rw, cl) = Target.Cells(rw, cl).Interior.Color
            End If
        Next
    Next
    rngcolor.Interior.Color = vbYellow
End Sub