ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ¿ï¾Ü³æ¤¸®æ®ÉÄæ¦CÅܦâ

[µo°Ý] ¿ï¾Ü³æ¤¸®æ®ÉÄæ¦CÅܦâ



Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    On Error Resume Next
     If Target.Count > 1 Then Exit Sub
    Cells.FormatConditions.Delete
   
With Target.EntireColumn.FormatConditions  'ÄæÅܦâ
        .Delete
        .Add xlExpression, , "TRUE"
        .Item(1).Interior.ColorIndex = Int(28)
    End With
   
With Target.EntireRow.FormatConditions  '¦CÅܦâ
        .Delete
        .Add xlExpression, , "TRUE"
        .Item(1).Interior.ColorIndex = Int(35)
    End With
   
With Target.FormatConditions  '³æ¤¸®æÅܦâ
        .Delete
        .Add xlExpression, , "TRUE"
        .Item(1).Interior.ColorIndex = Int(4)
    End With
End Sub

¦U¦ì¤j¤j
¤p§Ì¬°¤F¤è«K¿ëÃѥثeªº¬Ý­þ­ÓÄæ¦C¡A¤Wºô¥h§ä¤F"¿ï¾Ü³æ¤¸®æ®ÉÄæ¦CÅܦâ"ªº»yªk
½T¹ê¬O¦³¹F¨ì§Ú­nªº®ÄªG
¦ý¬O
¿O¸¹¨º­ÓÄæ¦ì«o¤£¨£¤F



½Ð°Ý¤W­±¨º¬q»yªk­þ¸Ì¼g¿ù¡A·Ð½Ðª¾¹Dªº¤j¤j­ÌÀ°§U¤p§Ì¸Ñ´b

¦^´_ 1# cowww


    ÁÂÁ«e½úµoªí¦¹¥DÃD
«á¾Ç¬ã²ß¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò

°õ¦æµ²ªG:



Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Target
   Dim xR As Range, xA As Range
   If .Columns.Count = Columns.CountLarge Then Exit Sub
   If .Count > 1 Or .Column = 1 Then Exit Sub
   Set xR = .Cells: Set xA = Range([B1], Cells(1, Columns.Count)).EntireColumn
   With Intersect(ActiveSheet.UsedRange, xA)
      .Interior.ColorIndex = xlNone
      Intersect(xR.EntireRow, .Cells).Interior.ColorIndex = 6
      Intersect(xR.EntireColumn, .Cells).Interior.ColorIndex = 6
   End With
   .Interior.ColorIndex = 4
End With
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 2# Andy2483


«D±`·PÁÂAndy2483¤j¤jªº¸Ñ´b
¦ý¬O
·d©w¤F¦C¦ì¡AÅܦ¨Äæ¦ìªº­ì¨ÓÃC¦â¤£¨£¤F

Åܦâ«e


Åܦâ«á

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-5-4 09:36 ½s¿è

¦^´_ 3# cowww


    ÁÂÁ«e½ú¦^´_
«á¾Ç¾Ç²ß¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò

°õ¦æµ²ªG:



Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Target
   Dim xR As Range, xA As Range, xB As Range
   If .Columns.Count = Columns.CountLarge Then Exit Sub
   If .Count > 1 Or .Column = 1 Or .Row = 1 Then Exit Sub
   Set xR = .Cells: Set xA = Range([B1], Cells(1, Columns.Count)).EntireColumn
   Set xB = Range([A2], Cells(Rows.Count, 1)).EntireRow
   With Intersect(ActiveSheet.UsedRange, xA, xB)
      .Interior.ColorIndex = xlNone
      Intersect(xR.EntireRow, .Cells).Interior.ColorIndex = 6
      Intersect(xR.EntireColumn, .Cells).Interior.ColorIndex = 6
   End With
   .Interior.ColorIndex = 4
End With
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 4# Andy2483

«D±`·PÁÂAndy2483¤j¤jªº¸Ñ´b
Äæ¦ìªº­I´ºÃC¦âÁÙ¬O·|®ø¥¢


TOP

¦^´_ 5# cowww


    ÁÂÁ«e½ú¦A¦^´_,ÁÂÁ½׾Â
«á¾Ç¾Ç²ß¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò

¼ÐÃD¦C¦b²Ä4¦C,°õ¦æµ²ªG:



Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Target
   Dim xR As Range, xA As Range, xB As Range
   If .Columns.Count = Columns.CountLarge Then Exit Sub
   If .Count > 1 Or .Column = 1 Or .Row < 5 Then Exit Sub
   Set xR = .Cells: Set xA = Range([B1], Cells(1, Columns.Count)).EntireColumn
   Set xB = Range([A5], Cells(Rows.Count, 1)).EntireRow
   With Intersect(ActiveSheet.UsedRange, xA, xB)
      .Interior.ColorIndex = xlNone
      Intersect(xR.EntireRow, .Cells).Interior.ColorIndex = 6
      Intersect(xR.EntireColumn, .Cells).Interior.ColorIndex = 6
   End With
   .Interior.ColorIndex = 4
End With
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 6# Andy2483

«D±`·PÁÂAndy2483¤j¤jªº¸Ñ´b

¦¨¥\¤F

TOP

¦^´_ 6# Andy2483

¥i§_½ÐAndy2483¤j¤j¸Ñ´b¤@¤U³o¬q»yªk
¤p§Ì§¹¥þ¬Ý¤£À´

TOP

¥»©«³Ì«á¥Ñ ­ã´£³¡ªL ©ó 2023-5-4 10:56 ½s¿è

³o­Ó¶ñ¦â¤èªk//
1) ¼vÅTÀx¦s®æªº­ì¦³©³¦â(¥]§t¿ï¨ú°Ïªº½d³ò)
2) ¤£¯à¨Ï¥Î½Æ»s©ÎÁÙ­ì¥\¯à

TOP

¦^´_ 8# cowww


    ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú,½Ð¦U¦ì«e½ú«ü±Ð

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Target
'¡ô¥H¤U¬OÃö©óIJµoªºµ{§Ç
   Dim xR As Range, xA As Range, xB As Range
   '¡ô«Å§i(xR,xA,xB)¬O Àx¦s®æÅܼÆ
   If .Columns.Count = Columns.CountLarge Then Exit Sub
   '¡ô¦pªGIJµoÄæ¼Æ¬O ³Ì¤jÄæ¼Æ!´Nµ²§ôµ{¦¡°õ¦æ
   If .Count > 1 Or .Column = 1 Or .Row < 5 Then Exit Sub
  '¡ô¦pªGIJµo®æ¼Æ¤j©ó1 ©Î IJµoÄæ¦ì¼Æ¬O1(AÄæ) ©ÎIJµo¦C¸¹¤p©ó 5!´Nµ²§ôµ{¦¡°õ¦æ
   Set xR = .Cells: Set xA = Range([B1], Cells(1, Columns.Count)).EntireColumn
   '¡ô¥OxR³oÀx¦s®æÅܼƬO IJµoªºÀx¦s®æ
   '¡ô¥OxA³oÀx¦s®æÅܼƬO ([B1]¨ì ²Ä1¦C³Ì«áÄæ½d³ò¦s®æ)©Ò¦bÄ檺¥þ³¡Àx¦s®æ

   Set xB = Range([A5], Cells(Rows.Count, 1)).EntireRow
   '¡ô¥OxB³oÀx¦s®æÅܼƬO ([A5]¨ì AÄæ³Ì«á¦C½d³ò¦s®æ)©Ò¦b¦Cªº¥þ³¡Àx¦s®æ
   With Intersect(ActiveSheet.UsedRange, xA, xB)
   '¡ô¥H¤U¬OÃö©ó¤T­ÓÀx¦s®æ°Ï°ì¥æ¶°«áªºÀx¦s®æ°Ï°ì µ{§Ç
   '1.¥»ªí¦³¨Ï¥ÎªºÀx¦s®æ :2.xAÅÜ¼Æ :3.xBÅܼÆ

      .Interior.ColorIndex = xlNone
      '¡ô¥O¦¹°Ï°ìÀx¦s®æ©³¦â¬O µL¦â
      Intersect(xR.EntireRow, .Cells).Interior.ColorIndex = 6
      '¡ô¥OIJµo®æ©Ò¦b¦¹°Ï°ìÀx¦s®æ¦C©³¦â¬O ¶À¦â
      Intersect(xR.EntireColumn, .Cells).Interior.ColorIndex = 6
      '¡ô¥OIJµo®æ©Ò¦b¦¹°Ï°ìÀx¦s®æÄ橳¦â¬O ¶À¦â
   End With
   .Interior.ColorIndex = 4
   '¡ô¥OIJµo®æ©³¦â¬O ºñ¦â
End With
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : §Ñ¥\¤£§Ñ¹L¡A§Ñ«è¤£§Ñ®¦¡C
ªð¦^¦Cªí ¤W¤@¥DÃD