Dim MergeCot As Integer Dim i As Integer With Sheet1
r = .Cells(.Rows.Count, 1).End(xlUp).Row For i = 2 To r
MergeStr = .Cells(i, 2).Value
MergeCot = .Cells(i, 2).MergeArea.Count .Cells(i, 2).UnMerge
.Range(.Cells(i, 2), .Cells(i + MergeCot - 1, 2)).Value = MergeStr i = i + MergeCot - 1 Next
.Range(\End With End Sub
范例14 高亮显示选定单元格区域
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Interior.ColorIndex = xlColorIndexNone
Target.Interior.ColorIndex = Int(56 * Rnd() + 1) End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
Cells.Interior.ColorIndex = xlColorIndexNone
Set rng = Application.Union(Target.EntireColumn, Target.EntireRow) rng.Interior.ColorIndex = Int(56 * Rnd() + 1) Set rng = Nothing End Sub
范例15 双击被保护单元格时不显示提示消息框
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Locked = True Then
MsgBox \此单元格已保护，不能编辑!\Cancel = True End If End Sub
范例16 单元格录入数据后自动保护
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim msg As Byte With Target
If Not Application.Intersect(Target, Range(\
If .Count > 1 Then
11
Range(\Exit Sub End If
ActiveSheet.Unprotect
If Len(Trim(.Value)) > 0 Then
msg = MsgBox(\当前单元格已录入数据,是否修改?\.Locked = IIf(msg = 6, False, True) End If
ActiveSheet.Protect
ActiveSheet.EnableSelection = 0 End If End With End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range(\
If Len(Trim(Target.Value)) > 0 Then
ActiveSheet.Unprotect Target.Locked = True ActiveSheet.Protect
ActiveSheet.EnableSelection = 0 End If End If End Sub
范例17 Target参数的使用方法
使用Address 属性
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Select Case Target.Address(0, 0)
Case \
Sh.Unprotect Case \
Sh.Protect Case Else End Select End Sub
使用Column属性和Row属性
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column < 3 And Target.Row < 11 Then
MsgBox \你选择了\单元格\End If End Sub
使用Intersect方法
12
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Union(Range(\Range(\Is Nothing Then
If Target.Count = 1 Then
MsgBox \你选择了\单元格\End If End If End Sub
第2章 Sheet（工作表）对象(返回)
范例18 引用工作表的方法
18-1 使用工作表名称
Sub ShtName()
Worksheets(\End Sub
18-2 使用工作表索引号
Sub ShtIndex()
Worksheets(Worksheets.Count).Select End Sub
18-3 使用工作表代码名称
Sub ShtCodeName() Sheet3.Select End Sub
范例19 选择工作表的方法
Sub ShtSelect()
MsgBox \下面将选择\工作表\ Sheet2.Select
MsgBox \下面将激活\工作表\ Sheet3.Activate End Sub
Sub SelectSht()
Dim Sht As Worksheet
13
For Each Sht In Worksheets Sht.Select False Next End Sub
Sub SelectSheets() Worksheets.Select End Sub
Sub ArraySheets()
Worksheets(Array(1, 3)).Select End Sub
范例20 遍历工作表的方法
20-1 使用For...Next 语句
Sub TraversalShtOne() Dim i As Integer Dim Str As String
For i = 1 To Worksheets.Count
Str = Str & Worksheets(i).Name & vbCrLf Next
MsgBox \工作簿中含有以下工作表：\End Sub
20-1 使用For Each...Next 语句
Sub TraversalShtTwo() Dim Sht As Worksheet Dim Str As String
For Each Sht In Worksheets
Str = Str & Sht.Name & vbCrLf Next
MsgBox \工作簿中含有以下工作表：\End Sub
范例21 工作表的添加与删除
Sub ShtAddOne()
Worksheets.Add.Name = \数据\End Sub
Sub ShtAddTwo()
Dim i As Integer
14
Dim Sht As Worksheet With Worksheets For i = 1 To 6
Set Sht = .Add(after:=Worksheets(.Count)) Sht.Name = i Next End With
Set Sht = Nothing End Sub
Sub ShtDel()
Dim Sht As Worksheet
Application.DisplayAlerts = False For Each Sht In Worksheets
If Sht.Name <> \工作表的添加与删除\ Sht.Delete End If Next
Application.DisplayAlerts = True Set Sht = Nothing End Sub
Sub ShtAddThree()
Dim Sht As Worksheet
For Each Sht In Worksheets If Sht.Name = \数据\
If MsgBox(\工作簿中已有\数据\工作表,是否删除后添加?\ Application.DisplayAlerts = False Sht.Delete
Application.DisplayAlerts = True Else
Exit Sub End If End If Next
Worksheets.Add.Name = \数据\ Set Sht = Nothing End Sub
Sub ShtAddFour()
Dim arr As Variant Dim i As Integer
Dim Sht As Worksheet On Error Resume Next
arr = Array(1, 2, 3, 4, 5, 6) With Worksheets
For i = 0 To UBound(arr)
Set Sht = .Add(after:=Worksheets(.Count)) Sht.Name = arr(i) Next End With
15