coafort

回復  coafort


Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
D ...
Andy2483 發表於 2024-2-1 19:54

真是太感謝大大
可以了
請問大大
如果我要精確一點
焦點在AR212至AR219及AX212至AZ219
變色的地方是AJ212至AJ219
請問該怎麼做呢？謝謝大大

coafort

回復  quickfixer


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

程式執行中,無法修改顏色
程式開頭加入if, cc  ...
quickfixer 發表於 2024-2-2 07:54

謝謝大大
執行後出現錯誤

quickfixer

回復 12# coafort

Option Explicit 那行刪掉或是加上     dim cc as string,nr as integer

Andy2483

回復 11# coafort
請前輩試試看以下效果是否適合
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim a As Range, b As Range, c As Range
With Target
   Set b = [AJ212:AJ219]
   Set c = [AR212:AR219,AX212:AZ219]
   For Each a In b
      If a.Interior.ColorIndex = 6 Then a.Interior.ColorIndex = xlNone
   Next
   Set c = Intersect(.Cells, c)
   If Not c Is Nothing Then Intersect(c.EntireRow, b).Interior.ColorIndex = 6
End With
End Sub

coafort

回復  coafort

Option Explicit 那行刪掉或是加上     dim cc as string,nr as integer
quickfixer 發表於 2024-2-2 08:16

變成點選的變色@@
不是我要的
依然感謝大大

coafort

回復  coafort
請前輩試試看以下效果是否適合
Option Explicit
Private Sub Worksheet_SelectionChange ...
Andy2483 發表於 2024-2-2 09:05

哈哈
感謝大大
可以了耶
讚讚讚

Andy2483

回復 16# coafort
謝謝論壇,謝謝前輩讓後學學到很多知識
以下是後學針對[AJ212:AJ219]如果原來有底色,但是選取[AR212:AR219,AX212:AZ219]之後變黃色,移開之後能恢復原來底色的方案
原來底色:

下載 (32.42 KB)

2024-2-2 11:19

選取後變黃色:

下載 (32.86 KB)

2024-2-2 11:20

移開後恢復原色:

下載 (32.42 KB)

2024-2-2 11:22

Option Explicit
Dim Brr
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim b As Range, c As Range, i&
With Target
   Set b = [AJ212:AJ219]: Set c = [AR212:AR219,AX212:AZ219]
   If Not IsArray(Brr) Then Brr = b: For i = 1 To UBound(Brr): Brr(i, 1) = b(i).Interior.ColorIndex: Next
   Set c = Intersect(.Cells, c)
   If Not c Is Nothing Then
      Intersect(c.EntireRow, b).Interior.ColorIndex = 6
      Else
      For i = 1 To UBound(Brr)
         If b(i).Interior.ColorIndex = 6 Then b(i).Interior.ColorIndex = Brr(i, 1)
      Next
      Brr = Empty
   End If
End With
End Sub

coafort

回復  coafort
謝謝論壇,謝謝前輩讓後學學到很多知識
以下是後學針對[AJ212:AJ219]如果原來有底色,但是選 ...
Andy2483 發表於 2024-2-2 11:20

報告大大
出現錯誤
細細大大

Andy2483

回復 18# coafort

是色差?還是偵錯?
再藉此帖學習RGB,學習方案如下:

Option Explicit
Dim Brr
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim b As Range, c As Range, i&
With Target
   Set b = [AJ212:AJ219]: Set c = [AR212:AR219,AX212:AZ219]
   If Not IsArray(Brr) Then
      ReDim Brr(1 To b.Count, 1 To 3)
      For i = 1 To UBound(Brr)
         Brr(i, 1) = b(i).Interior.Color Mod 256
         Brr(i, 2) = b(i).Interior.Color \ 256 Mod 256
         Brr(i, 3) = b(i).Interior.Color \ 256 ^ 2 Mod 256
      Next
   End If
   Set c = Intersect(.Cells, c)
   If Not c Is Nothing Then
      Intersect(c.EntireRow, b).Interior.Color = RGB(255, 255, 0) '黃色
      Else
      For i = 1 To UBound(Brr)
         If b(i).Interior.Color = RGB(255, 255, 0) Then b(i).Interior.Color = RGB(Brr(i, 1), Brr(i, 2), Brr(i, 3))
      Next
      Brr = Empty
   End If
End With
End Sub

coafort

下載 (328.09 KB)

2024-2-2 14:01

回復  coafort

是色差?還是偵錯?
再藉此帖學習RGB,學習方案如下:

Option Explicit
Dim Brr
Priv ...
Andy2483 發表於 2024-2-2 13:37

報告大大
是偵錯
謝謝大大