Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2482|回复: 6

[已解决]求高手帮忙修改一下代码

[复制链接]
发表于 2014-6-6 09:48 | 显示全部楼层 |阅读模式
求助VB代码修改.zip (9.45 KB, 下载次数: 7)
QQ图片20140606094624.jpg
发表于 2014-6-6 10:33 | 显示全部楼层
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.     Dim T As Range, T1 As Range
  3.     Dim R, C
  4.     Set T = Target
  5.     R = T.Row: C = T.Column
  6.     Set T1 = Cells(4, C)
  7.     If (R >= 5 And R <= 13 And R Mod 2 = 1) And T.Count = 1 Then
  8.       If T1 = "打开" Then
  9.            If T.Value = "√" Then
  10.              T.Value = "×"
  11.              T.Offset(0, 1) = "×"
  12.              T.Offset(0, 1).Interior.ColorIndex = 46
  13.              T.Interior.ColorIndex = 46
  14.            Else
  15.              T.Value = "√"
  16.              T.Interior.ColorIndex = 6
  17.            End If
  18.        ElseIf T1 = "编辑" Then
  19.            If T.Offset(0, -1) = "×" Then MsgBox "设置工作表不能打开情况下,默认不能编辑!": Exit Sub
  20.            If T.Value = "√" Then
  21.              T.Value = "×"
  22.              T.Interior.ColorIndex = 46
  23.            Else
  24.              T.Value = "√"
  25.              T.Interior.ColorIndex = 6
  26.            End If
  27.        End If
  28.        T1.Select
  29.     End If
  30. End Sub
复制代码
回复

使用道具 举报

发表于 2014-6-6 10:48 | 显示全部楼层
代码太长了,狠狠简化了一下。
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.     Dim T As Range, T1 As Range
  3.     Dim R, C, Str, Colr, xLong
  4.     Set T = Target: R = T.Row: C = T.Column
  5.     Set T1 = Cells(4, C)
  6.     Str = IIf(T = "√", "×", "√")
  7.     Colr = IIf(T = "√", 46, 6)
  8.     If (R >= 5 And R <= 13 And R Mod 2 = 1) And T.Count = 1 Then
  9.         If T1 = "编辑" And T.Offset(0, -1) = "×" Then MsgBox "设置工作表不能打开情况下,默认不能编辑!": Exit Sub
  10.         xLong = IIf(T1 = "打开" And T.Value = "√", 2, 1)
  11.         T.Resize(1, xLong) = Str
  12.         T.Resize(1, xLong).Interior.ColorIndex = Colr
  13.         T1.Select
  14.     End If
  15. End Sub
复制代码
回复

使用道具 举报

发表于 2014-6-6 10:51 | 显示全部楼层    本楼为最佳答案   
请看附件。

求助VB代码修改.rar

9.71 KB, 下载次数: 11

回复

使用道具 举报

 楼主| 发表于 2014-6-6 13:21 | 显示全部楼层
grf1973 发表于 2014-6-6 10:51
请看附件。

大神啊!!!膜拜!!
回复

使用道具 举报

 楼主| 发表于 2014-6-7 12:16 | 显示全部楼层
大侠,A:G不要作用上去,留着自由编辑 怎么修改啊
回复

使用道具 举报

发表于 2014-6-10 10:55 | 显示全部楼层
这几天忙,没时间上。前面加一句 if Target.column<=7 then exit sub。见代码。
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.     Dim T As Range, T1 As Range
  3.     Dim R, C, Str, Colr, xLong
  4.     Set T = Target: R = T.Row: C = T.Column
  5.     If C <= 7 Then Exit Sub
  6.     Set T1 = Cells(4, C)
  7.     Str = IIf(T = "√", "×", "√")
  8.     Colr = IIf(T = "√", 46, 6)
  9.     If (R >= 5 And R <= 13 And R Mod 2 = 1) And T.Count = 1 Then
  10.         If T1 = "编辑" And T.Offset(0, -1) = "×" Then MsgBox "设置工作表不能打开情况下,默认不能编辑!": Exit Sub
  11.         xLong = IIf(T1 = "打开" And T.Value = "√", 2, 1)
  12.         T.Resize(1, xLong) = Str
  13.         T.Resize(1, xLong).Interior.ColorIndex = Colr
  14.         T1.Select
  15.     End If
  16. End Sub

复制代码

评分

参与人数 1 +1 收起 理由
布烈瑟侬 + 1 很给力!

查看全部评分

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 03:35 , Processed in 0.356532 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表