如何修改使用范围？

dzsrmyh

如何修改使用范围？

ykcbf1100

工作表事件

ykcbf1100

工作表带事件

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     If Not Intersect(Target, Me.Range("A:H")) Is Nothing Then
   
3.         With Me.Range("A:H")
   
4.             .Font.Bold = False
   
5.             .Font.Color = RGB(0, 0, 0)
   
6.         End With
   
7.         With Target.EntireRow
   
8.             .Resize(1, 8).Font.Bold = True ' 粗体
   
9.             .Resize(1, 8).Font.Color = RGB(255, 0, 0) ' 红色字体
   
10.         End With
    
11.     End If
    
12. End Sub
    

复制代码

dzsrmyh

草爷您好，代码好用，我没有描述清楚，就是这个范围应该是从第二行开始的，最终效果就是：如我点击第三行后，在点击第一行时，第三行恢复原有格式，而第一行也应该是原有格式，我自行将范围修改成A2:H500后，当我点击第一行时，第一行没有改变原有格式（是我想要的结果），但下面的没有恢复原有格式。

ykcbf1100

dzsrmyh 发表于 2024-6-27 21:42
草爷您好，代码好用，我没有描述清楚，就是这个范围应该是从第二行开始的，最终效果就是：如我点击第三行后 ...

范围改一下吧。

ykcbf1100

改一下吧。。

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     r = Me.Cells(Rows.Count, 1).End(3).Row
   
3.     If Not Intersect(Target, Me.Range("A2:H" & r)) Is Nothing Then
   
4.         With Me.Range("A2:H" & r)
   
5.             .Font.Bold = False
   
6.             .Font.Color = RGB(0, 0, 0)
   
7.         End With
   
8.         With Target.EntireRow
   
9.             .Resize(1, 8).Font.Bold = True ' 粗体
   
10.             .Resize(1, 8).Font.Color = RGB(255, 0, 0) ' 红色字体
    
11.         End With
    
12.     End If
    
13. End Sub

复制代码

dzsrmyh

ykcbf1100 发表于 2024-6-27 21:51
范围改一下吧。

这下完美了，谢谢草爷

dzsrmyh

ykcbf1100 发表于 2024-6-27 21:53
改一下吧。。

如何在现有代码基础上添加在点击单元格所在范围内行加粗和红色字体显示的同时将字号也相应增加1号显示，离开这一行时恢复全部原有格式。

yjh_27

dzsrmyh 发表于 2024-6-28 13:38
如何在现有代码基础上添加在点击单元格所在范围内行加粗和红色字体显示的同时将字号也相应增加1号显示， ...

加几行代码

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     Dim r As Long
   
3.     r = Me.Cells(Rows.Count, 1).End(xlUp).Row
   
4.     zihao = 10
   
5.     If Target.Row = 1 Then
   
6.         zihao = Target.Offset(1, 0).Font.Size
   
7.         If Target.Offset(1, 0).Font.Color = RGB(255, 0, 0) Then zihao = zihao - 1
   
8.     Else
   
9.         zihao = Target.Font.Size
   
10.         If Target.Font.Color = RGB(255, 0, 0) Then zihao = zihao = zihao - 1
    
11.     End If
    
12.     If Target.Row = 1 Then
    
13.         With Me.Range("A2:H" & r)
    
14.             .Font.Bold = False
    
15.             .Font.Color = RGB(0, 0, 0)
    
16.             .Font.Size = zihao
    
17.         End With
    
18.         Exit Sub ' 当点击第一行时，直接退出子程序，不执行后续操作
    
19.     End If
    
20.     If Not Intersect(Target, Me.Range("A2:H" & r)) Is Nothing Then
    
21.         With Me.Range("A2:H" & r)
    
22.             .Font.Bold = False
    
23.             .Font.Color = RGB(0, 0, 0)
    
24.             .Font.Size = zihao
    
25.         End With
    
26.         With Target.EntireRow
    
27.             .Resize(1, 8).Font.Bold = True ' 粗体
    
28.             .Resize(1, 8).Font.Color = RGB(255, 0, 0) ' 红色字体
    
29.             .Resize(1, 8).Font.Size = zihao + 1
    
30.         End With
    
31.     End If
    
32. End Sub
    
33. 
    

复制代码

dzsrmyh

yjh_27 发表于 2024-6-28 14:05
加几行代码

非常感谢，可以达到我想要的效果