- 帖子
- 154
- 主題
- 1
- 精華
- 0
- 積分
- 200
- 點名
- 1
- 作業系統
- windwos 7
- 軟體版本
- 64bit
- 閱讀權限
- 20
- 註冊時間
- 2017-5-29
- 最後登錄
- 2025-1-1
|
本帖最後由 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 |
|
發表於 2024-2-1 23:31
| 
