VBA工作表操作

对sheet 进行保护：

Sub 保护()
Dim Sh As Worksheet
For Each Sh In Worksheets
Sh.Protect
'加密码123
Sh.Protect "123"

Next
MsgBox "OK"
End Sub

Sub 撤销保护()
Dim Sh As Worksheet
For Each Sh In Worksheets
Sh.Unprotect "123"
Next
MsgBox "OK"
End Sub

 

高亮显示当前行：

 

右击标签，选择查看代码：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'当选择新的单元格时，将这个单元格(或者区域)定义为名称“XM”，在条件格式设置中可以引用这个名称。
ThisWorkbook.Names.Add "XM", Target
End Sub

同时在表格中，设置条件格式：

将代码粘贴完成后，返回工作表中，选择A4:I15，点击菜单“格式—条件格式”，设置：
公式1：=(A4<>"")*(A4=XM)
(如果A4不为空，并且A4等于XM)
公式2：=ROW()=ROW(XM)
(如果当前的行号等于XM的行号)

让行列突出显示 ：

右击标签输入代码：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Rng As Range
Set Rng = Target.Range("a1")
Cells.Interior.ColorIndex = 0  '清除所有背景色
Rng.EntireColumn.Interior.ColorIndex = 40  '设置当前列颜色
Rng.EntireRow.Interior.ColorIndex = 36  '设置当前行颜色
End Sub

下面是颜色index：

如果想让所有的表都具有这样的功能，则应该在thisworkbook里加入：

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

‘If Application.CutCopyMode Then Exit Sub '如果处于选取状态则退出程序 （可有可无）
Dim Rng As Range
Set Rng = Target.Range("a1")
Cells.Interior.ColorIndex = 0  '清除所有背景色
Rng.EntireColumn.Interior.ColorIndex = 40  '设置当前列颜色
Rng.EntireRow.Interior.ColorIndex = 36  '设置当前行颜色
End Sub
 
自动在后一列加上时间日期：

在列a写入数据后，后列自动加上日期：

在sheet1里输入以下代码：

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then Target.Offset(0, 2) = Date
End Sub

 

中间一行是核心代码，意思是：当第1列(即A列)录入数据时，右边第2列(即C列)输入一个日期。
如果你的要求是“B列(第2列)输入数据后C列(B列的右边第1列)自动输入一个日期”，则中间一行代码应改为：
If Target.Column = 2 Then Target.Offset(0, 1) = Date

如果你要求“D列(第4列)输入数据后，A列(D列的左边3列)自动输入日期”，则中间一行代码改为：
If Target.Column = 4 Then Target.Offset(0, -3) = Date

如果要输入当前时间，怎么办？
代码中，Date 表示当前日期，你可以像吃自助餐一样，把 Date 换成合你口味的东西：
Time ：当前时间
Now ：当前日期时间

 

用单元格内容更新sheet标签名：

 

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$C$2" And Target <> "" Then '如果单元格地址为 $C$2 并且 单元格不为空
        Me.Name = Target.Value '用单元格的内容命名工作表
    End If
End Sub

限定sheet光标范围：

 有时，为了保护其它区域的数据，或者提高录入的准确性，我们希望光标在一定的范围内活动，不乱蹿乱跳。
为了加快录入速度，希望光标自动跳到下一行，也是常有的事。
实现的方法有几种，今天说属性，就推荐设置属性的方法。

 

选择工作表，属性框中的Name显示的是工作表的标签(如“通讯录”)。

下一行的属性是ScrollArea，这个属性的意思是“允许滚动的区域”，在这里用键盘输入单元格区域地址，如：A3:F20，这个区域便是光标活动区域，不在这个范围内的单元格不能被选择。F列输入数据并回车后，光标自动跳到A列。

如果只修改电话与手机号码，可将ScrollArea设置为C3:D100。

使用该属性的优点是修改区域比较方便，弱点是只能设置一个矩形区域，不能设置不连续的单元格区域。

在thisworkbook里输入以下代码：
 Private Sub Workbook_Open()
Sheet1.ScrollArea = "a3:f20"
End Sub

-----

那，如果在同一个excel表格中的另一sheet要单独来设置区域则：

ScrollArea属性设置的值不能被保存，如果编辑区域相对固定，不希望经常进行人工设定，可用VBA为你效劳。
右键点击工作表标签，选择“查看代码”，将下面的代码粘贴到光标处：

Private Sub Worksheet_Activate()
ScrollArea = "b3:j12"
End Sub

 

工作表属性，自动重算

工作表太多了，运算很慢，手动重算却让人觉得麻烦，愿意接受的人不多。

如：sheet1中有一个成绩的基本数据表：

而我想点一下sheet就能重算出表的平均数：

工作表有一个属性“EnableCalculation”，决定该工作表是否自动重算。
如果自动重算工作表，值为 True，如果不重新计算工作表，值为 False。
用鼠标点击属性框中的“EnableCalculation”，右边显示一个下拉箭头。
点击下拉箭头，根据需要选择True或者False。

在thisworkbook中输入vba代码解决：

Private Sub Workbook_Open()
Dim Sh As Worksheet
For Each Sh In Worksheets
Sh.EnableCalculation = False
Next
ActiveSheet.EnableCalculation = True
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Sh.EnableCalculation = False
Sh.EnableCalculation = True
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
Sh.EnableCalculation = False
End Sub

工程管理器中每一个节点(Sheet1、Sheet2、Sheet3……ThisWorkbook)为一个模块，Sheet1等称工作表模块，有多少个工作表就有多少个模块。ThisWorkbook是一个特殊的模块，称工作簿模块，一个工作簿只有一个。

一般情况下，程序在哪个工作表模块中，就对哪个工作表产生作用。

程序写在工作簿模块中，可对整个工作簿产生作用。

当把代码粘贴到工作簿模块中后，当工作表被激活时，就会将该工作表的“重算”设为“是”。任意时刻，只有一个工作表处于“重算”状态。其它工作表都处于冬眠状态。这样，工作表的速度就提高了。

注：

 

 

只给用户一次数据写入的机会：

要求：录入数据后，能够锁定单元格，使数据不被修改。
1、选择要设置的区域，如A3:I1000，按 Ctrl+I打开单元格格式对话框，取消“锁定”与“隐藏”选项
2、右键点击工作表标签，选择“查看代码”，将下面的代码粘贴到光标处：
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range
    Application.EnableEvents = False
    Me.Unprotect ("123") '撤销工作表保护
   
    For Each Rng In Target
   
        If Not Intersect(Rng, Range("A3:F1000,H3:I1000")) Is Nothing Then  '如果被修改的单元格在 A3:I1000 范围内
           
            If Rng.Column = 2 Then
                Rng.Offset(0, -1) = Date
                Rng.Offset(0, -1).Locked = True
            End If
           
            Rng.Locked = True '锁定单元格
        End If
    Next
   
    Me.Protect ("123") '保护工作表
    Application.EnableEvents = True
End Sub

--------------

当修改单元格时，程序自动将单元格锁定。      
程序中的工作表保护密码可自由设置。      
如果要修改锁定的单元格，可先取消工作表保护。      
      
如果要保护的区域只是工作表的一部分，可在程序中添加二行代码，对区域作限制。      
      
如：只有编辑A3:I1000区域时，才将单元格锁定，将代码修改为：      
Private Sub Worksheet_Change(ByVal Target As Range)      
    Dim Rng As Range      
    Me.Unprotect ("123") '撤销工作表保护      
          
    For Each Rng In Target      
        If Not Intersect(Rng, Range("A3:I1000")) Is Nothing Then '如果被修改的单元格在 A3:I1000 范围内      
            Rng.Locked = True '锁定单元格      
        End If      
    Next      
          
    Me.Protect ("123") '保护工作表      
End Sub      

------

如果G列的“备注”也不被锁定，可将上面的 Range("A3:I1000") 改为 Range("A3:F1000,H3:I1000")，使区域不包含G列     
     
     
如果要增加自动录入日期的功能，代码为：     
      
 Private Sub Worksheet_Change(ByVal Target As Range)    
     Dim Rng As Range    
     Application.EnableEvents = False    
     Me.Unprotect ("123") '撤销工作表保护    
         
     For Each Rng In Target    
         
         If Not Intersect(Rng, Range("A3:F1000,H3:I1000")) Is Nothing Then  '如果被修改的单元格在 A3:I1000 范围内    
                 
             If Rng.Column = 2 Then '如果列号等于2 (B列)    
                 Rng.Offset(0, -1) = Date ’该单元格左边第1个单元格输入一个当前日期    
                 Rng.Offset(0, -1).Locked = True’并且锁定它    
             End If    
                 
             Rng.Locked = True '锁定单元格    
         End If    
     Next    
         
     Me.Protect ("123") '保护工作表    
     Application.EnableEvents = True    
 End Sub    
     

单击单元格时自动输入数据，再次单击，改变数据：

实现单击D3-D3时输入男女

J3-J13输入勾

K3-K13输入三好学生

在sheet里输入：

 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Rng As Range
    Application.EnableEvents = False
   
    For Each Rng In Target
        If Rng.Row > 2 Then '如果单元格行号大于2
       
            If Rng.Column = 4 Then '如果 列号等于4 (D列)
                Rng = IIf(Rng = "男", "女", "男")
               
            ElseIf Rng.Column = 10 Then '如果 列号等于10 (J列)
                Rng = IIf(Rng = "√", "", "√")
               
            ElseIf Rng.Column = 11 Then '如果 列号等于11 (K列)
                Rng = IIf(Rng = "三好学生", "", "三好学生")
               
            End If
           
        End If
    Next
   
    Application.EnableEvents = True
End Sub