返回列表 上一主題 發帖

[發問] 改變儲存格顏色

回復 1# Hyuan


若滑鼠移到"表格內已設定格式化條件的儲存格"的位置時,不會改變原格式化的條件
設定(只是改變顏色而已)。

呵呵,你的問題很有意思!
不管儲存格格式是什麼顏色,格式化條件的效果會覆蓋掉原本的儲存格格式
所以你要改變有格式化條件的儲存格顏色,必須先移除該格的格式化條件
但是這樣就會不知道當初的格式化條件,所以要先複製格式化條件到其它格


順序如下:
1.複製點選的格式化條件到某一格(我的程式是最後一格)
2.刪除點選的格式化條件
3.為點選的儲存格上顏色
4.當點到其它儲存格時,把最後一個的格式化條件複製回上一格


程式如下:
Dim pre As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
If Application.CutCopyMode = xlCopy Then Me.Paste
On Error Resume Next
If Not pre Is Nothing Then
  Cells(Rows.Count, Columns.Count).Copy
  pre.PasteSpecial Paste:=xlPasteFormats
End If
Target.Copy
Cells(Rows.Count, Columns.Count).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False: Target.Select
Target.FormatConditions.Delete
Target.Interior.ColorIndex = 40
Set pre = Target
Application.EnableEvents = True
End Sub
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

回復 3# Hyuan


我自己嘗試,沒有這個狀況耶,

應該是你有不少函數觸發自動重算,加上這兩行試試

Dim pre As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlManual
If Application.CutCopyMode = xlCopy Then Me.Paste
On Error Resume Next
If Not pre Is Nothing Then
  Cells(Rows.Count, Columns.Count).Copy
  pre.PasteSpecial Paste:=xlPasteFormats
End If
Target.Copy
Cells(Rows.Count, Columns.Count).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False: Target.Select
Target.FormatConditions.Delete
Target.Interior.ColorIndex = 40
Set pre = Target
Application.EnableEvents = True
Application.Calculation = xlAutomatic
End Sub
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

本帖最後由 n7822123 於 2018-12-5 13:06 編輯

回復 4# n7822123

發現小BUG,關掉自動重算會讓自動貼上失效
修改一下順序

Dim pre As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error Resume Next
If Application.CutCopyMode = xlCopy Then Me.Paste
Application.Calculation = xlManual

If Not pre Is Nothing Then
  Cells(Rows.Count, Columns.Count).Copy
  pre.PasteSpecial Paste:=xlPasteFormats
End If
Target.Copy
Cells(Rows.Count, Columns.Count).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False: Target.Select
Target.FormatConditions.Delete
Target.Interior.ColorIndex = 40
Set pre = Target
Application.EnableEvents = True
Application.Calculation = xlAutomatic
End Sub
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

        靜思自在 : 好事要提得起,是非要放得下,成就別人即是成就自己。
返回列表 上一主題