coafort

¦^´_  coafort
½Ð«e½ú¸Õ¸Õ¬Ý¥H¤U®ÄªG¬O§_¾A¦X
Option Explicit
Private Sub Worksheet_SelectionChange ...
Andy2483 µoªí©ó 2024-2-2 09:05

ǢǢ
·PÁ¤j¤j
¥i¥H¤F­C
ÆgÆgÆg

coafort

¦^´_  coafort

Option Explicit ¨º¦æ§R±¼©Î¬O¥[¤W     dim cc as string,nr as integer
quickfixer µoªí©ó 2024-2-2 08:16

Åܦ¨ÂI¿ïªºÅܦâ@@
¤£¬O§Ú­nªº
¨ÌµM·PÁ¤j¤j

Andy2483

¦^´_ 11# coafort
½Ð«e½ú¸Õ¸Õ¬Ý¥H¤U®ÄªG¬O§_¾A¦X
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

quickfixer

¦^´_ 12# coafort

Option Explicit ¨º¦æ§R±¼©Î¬O¥[¤W     dim cc as string,nr as integer

coafort

¦^´_  quickfixer


    ¸Ó¦ì§@ªÌªºµ{¦¡½X¦³2­Ó°ÝÃD

µ{¦¡°õ¦æ¤¤,µLªk­×§ïÃC¦â
µ{¦¡¶}ÀY¥[¤Jif, cc  ...
quickfixer µoªí©ó 2024-2-2 07:54

ÁÂÁ¤j¤j
°õ¦æ«á¥X²{¿ù»~

coafort

¦^´_  coafort


Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
D ...
Andy2483 µoªí©ó 2024-2-1 19:54

¯u¬O¤Ó·PÁ¤j¤j
¥i¥H¤F
½Ð°Ý¤j¤j
¦pªG§Ú­nºë½T¤@ÂI
µJÂI¦bAR212¦ÜAR219¤ÎAX212¦ÜAZ219
Åܦ⪺¦a¤è¬OAJ212¦ÜAJ219
½Ð°Ý¸Ó«ç»ò°µ©O¡HÁÂÁ¤j¤j

quickfixer

¦^´_ 9# quickfixer


    ¸Ó¦ì§@ªÌªºµ{¦¡½X¦³2­Ó°ÝÃD

µ{¦¡°õ¦æ¤¤,µLªk­×§ïÃC¦â
µ{¦¡¶}ÀY¥[¤Jif, cc ¬Ý­n¤£­n¥Î¬Y­Ócell¥N´À
cc = "ÃC¦â¥i­×§ï"
If cc = "ÃC¦â¥i­×§ï" Then Exit Sub

¿ï¨úÄæ¦ì·|§âµLÃöªº¦C¼Æ¥þ³¡©ñ¤J°}¦C,¤]¤£¯à¿ï¾ã­Ó¤u§@ªí,µ{¦¡·|lag¶W¤[
²³æ¥[­Ó­­¨î,¥i¿ï¨úªº¦C¤W­­100,Äæ¤W­­26,³o­n¬Ý¹q¸£®Ä¯à­×§ï

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Static rngcolor As Range
    Static OldColor As Variant
    Dim rw As Long, cl As Long
   
    'cc = "ÃC¦â¥i­×§ï"
    If cc = "ÃC¦â¥i­×§ï" 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

quickfixer

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

¼Ó¥D­nªºÀ³¸Ó¬O³o­Ó¥\¯à

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
      '¡ô¥O¤@¶}©l¿ï¨ú®æ¬OARÄæÀx¦s®æ½d³òªº¥ª°¼11ÄæÀx¦s®æ©³¦â¬O¶À¦â
   End If
End With
End Sub

coafort

¦^´_  coafort

¤u§@ªí¼Ò²Õ¤U´Ó¤J:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Ta ...
Andy2483 µoªí©ó 2024-2-1 18:57

³ø§i¤j¤j
Â÷¶}«á¶À©³¤£·|®ø¥¢­C
ÁÂÁ¤j¤j