coafort

帖子: 162
主題: 33
精華: 0
積分: 243
點名: 0
作業系統: win7
軟體版本: excel 2003
閱讀權限: 20
註冊時間: 2018-1-5
最後登錄: 2024-10-22

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2024-2-1 13:26 | 只看該作者

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

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

樓主熱帖

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1447
主題: 40
精華: 0
積分: 1471
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-12-5

2^#

發表於 2024-2-1 14:23 | 只看該作者

回復 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

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

coafort

中學生 Rank: 2

帖子: 162
主題: 33
精華: 0
積分: 243
點名: 0
作業系統: win7
軟體版本: excel 2003
閱讀權限: 20
註冊時間: 2018-1-5
最後登錄: 2024-10-22

3^#

發表於 2024-2-1 17:36 | 只看該作者

本帖最後由 coafort 於 2024-2-1 17:38 編輯

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

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

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1447
主題: 40
精華: 0
積分: 1471
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-12-5

4^#

發表於 2024-2-1 18:29 | 只看該作者

本帖最後由 Andy2483 於 2024-2-1 19:05 編輯

回復 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

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

coafort

中學生 Rank: 2

帖子: 162
主題: 33
精華: 0
積分: 243
點名: 0
作業系統: win7
軟體版本: excel 2003
閱讀權限: 20
註冊時間: 2018-1-5
最後登錄: 2024-10-22

5^#

發表於 2024-2-1 18:51 | 只看該作者

回復 coafort

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

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

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1447
主題: 40
精華: 0
積分: 1471
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-12-5

6^#

發表於 2024-2-1 18:57 | 只看該作者

本帖最後由 Andy2483 於 2024-2-1 19:07 編輯

回復 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

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

coafort

中學生 Rank: 2

帖子: 162
主題: 33
精華: 0
積分: 243
點名: 0
作業系統: win7
軟體版本: excel 2003
閱讀權限: 20
註冊時間: 2018-1-5
最後登錄: 2024-10-22

7^#

發表於 2024-2-1 19:18 | 只看該作者

回復 coafort

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

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

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1447
主題: 40
精華: 0
積分: 1471
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-12-5

8^#

發表於 2024-2-1 19:54 | 只看該作者

回復 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

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

quickfixer

中學生 Rank: 2

帖子: 154
主題: 1
精華: 0
積分: 200
點名: 31
作業系統: windwos 7
軟體版本: 64bit
閱讀權限: 20
註冊時間: 2017-5-29
最後登錄: 2024-11-28

9^#

發表於 2024-2-1 23:31 | 只看該作者

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

樓主要的應該是這個功能

TOP

quickfixer

中學生 Rank: 2

帖子: 154
主題: 1
精華: 0
積分: 200
點名: 31
作業系統: windwos 7
軟體版本: 64bit
閱讀權限: 20
註冊時間: 2017-5-29
最後登錄: 2024-11-28

10^#

發表於 2024-2-2 07:54 | 只看該作者

本帖最後由 quickfixer 於 2024-2-2 07:56 編輯

回復 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

TOP