EXCEL之工作表(Worksheet)基本操作应用示例(转)

最新推荐文章于 2024-06-18 14:30:00 发布

feng2375

最新推荐文章于 2024-06-18 14:30:00 发布

阅读量2k

点赞数

分类专栏： asp.net(资料）文章标签：工作 excel string integer function each

本文链接：https://blog.csdn.net/feng2375/article/details/3725577

版权

asp.net(资料）专栏收录该内容

98 篇文章 0 订阅

订阅专栏

在编写代码时，经常要引用工作表的名字、知道工作表在工作簿中的位置、增加工作表、删除工作表、复制工作表、移动工作表、重命名工作表，等等。下面介绍与此有关及相关的一些属性和方法示例。

-------------------------------------------------------------------------------
[示例1]增加工作表(Add方法)
Sub AddWorksheet()
    MsgBox "在当前工作簿中添加一个工作表"
    Worksheets.Add
    MsgBox "在当前工作簿中的工作表sheet2之前添加一个工作表"
    Worksheets.Add before:=Worksheets("sheet2")
    MsgBox "在当前工作簿中的工作表sheet2之后添加一个工作表"
    Worksheets.Add after:=Worksheets("sheet2")
    MsgBox "在当前工作簿中添加3个工作表"
    Worksheets.Add Count:=3
End Sub
示例说明：Add方法带有4个可选的参数，其中参数Before和参数After指定所增加的工作表的位置，但两个参数只能选一；参数Count用来指定增加的工作表数目。

--------------------------------------------------------------------------------
[示例2]复制工作表(Copy方法)
Sub CopyWorksheet()
    MsgBox "在当前工作簿中复制工作表sheet1并将所复制的工作表放在工作表sheet2之前"
    Worksheets("sheet1").Copy Before:=Worksheets("sheet2")
    MsgBox "在当前工作簿中复制工作表sheet2并将所复制的工作表放在工作表sheet3之后"
    Worksheets("sheet2").Copy After:=Worksheets("sheet3")
End Sub
示例说明：Copy方法带有2个可选的参数，即参数Before和参数After，在使用时两个参数只参选一。

--------------------------------------------------------------------------------
[示例3]移动工作表(Move方法)
Sub MoveWorksheet()
    MsgBox "在当前工作簿中将工作表sheet3移至工作表sheet2之前"
    Worksheets("sheet3").Move Before:=Worksheets("sheet2")
    MsgBox "在当前工作簿中将工作表sheet1移至最后"
    Worksheets("sheet1").Move After:=Worksheets(Worksheets.Count)
End Sub
示例说明：Move方法与Copy方法的参数相同，作用也一样。

--------------------------------------------------------------------------------
[示例4]隐藏和显示工作表(Visible属性)
[示例4-01]
Sub testHide()
    MsgBox "第一次隐藏工作表sheet1"
    Worksheets("sheet1").Visible = False
    MsgBox "显示工作表sheet1"
    Worksheets("sheet1").Visible = True
    MsgBox "第二次隐藏工作表sheet1"
    Worksheets("sheet1").Visible = xlSheetHidden
    MsgBox "显示工作表sheet1"
    Worksheets("sheet1").Visible = True
    MsgBox "第三次隐藏工作表sheet1"
    Worksheets("sheet1").Visible = xlSheetHidden
    MsgBox "显示工作表sheet1"
    Worksheets("sheet1").Visible = xlSheetVisible
    MsgBox "第四隐藏工作表sheet1"
    Worksheets("sheet1").Visible = xlSheetVeryHidden
    MsgBox "显示工作表sheet1"
    Worksheets("sheet1").Visible = True
    MsgBox "第五隐藏工作表sheet1"
    Worksheets("sheet1").Visible = xlSheetVeryHidden
    MsgBox "显示工作表sheet1"
    Worksheets("sheet1").Visible = xlSheetVisible
End Sub
示例说明：本示例演示了隐藏和显示工作表的各种情形。其中，使用xlSheetVeryHidden常量来隐藏工作表，将不能通过选择工作表菜单栏中的“格式”——“工作表”——“取消隐藏”命令来取消隐藏。

--------------------------------------------------------------------------------
[示例4-02]
Sub ShowAllSheets()
    MsgBox "使当前工作簿中的所有工作表都显示(即将隐藏的工作表也显示)"
    Dim ws As Worksheet
    For Each ws In Sheets
      ws.Visible = True
    Next ws
End Sub

--------------------------------------------------------------------------------
[示例5]获取工作表数(Count属性)
[示例5-01]
Sub WorksheetNum()
    Dim i As Long
    i = Worksheets.Count
    MsgBox "当前工作簿的工作表数为：" & Chr(10) & i
End Sub

--------------------------------------------------------------------------------
[示例5-02]
Sub WorksheetNum()
    Dim i As Long
    i = Sheets.Count
    MsgBox "当前工作簿的工作表数为：" & Chr(10) & i
End Sub
示例说明：在一个包含图表工作表的工作簿中运行上述两段代码，将会得出不同的结果，原因是对于Sheets集合来讲，工作表包含图表工作表。应注意Worksheets集合与Sheets集合的区别，下同。

--------------------------------------------------------------------------------
[示例6]获取或设置工作表名称(Name属性)
[示例6-01]
Sub NameWorksheet()
    Dim sName As String, sChangeName As String
    sName = Worksheets(2).Name
    MsgBox "当前工作簿中第2个工作表的名字为：" & sName
    sChangeName = "我的工作表"
    MsgBox "将当前工作簿中的第3个工作表名改为：" & sChangeName
    Worksheets(3).Name = sChangeName
End Sub
示例说明：使用Name属性可以获取指定工作表的名称，也可以设置工作表的名称。

--------------------------------------------------------------------------------
[示例6-02]重命名工作表
Sub ReNameSheet()
     Dim xStr As String
Retry:
     Err.Clear
     xStr = InputBox("请输入工作表的新名称:" _
         , "重命名工作表", ActiveSheet.Name)
     If xStr = "" Then Exit Sub
     On Error Resume Next
     ActiveSheet.Name = xStr
     If Err.Number <> 0 Then
       MsgBox Err.Number & " " & Err.Description
       Err.Clear
       GoTo Retry
      End If
      On Error GoTo 0
      '.........
End Sub

--------------------------------------------------------------------------------
[示例7]激活/选择工作表(Activate方法和Select方法)
[示例7-01]
Sub SelectWorksheet()
    MsgBox "激活当前工作簿中的工作表sheet2"
    Worksheets("sheet2").Activate
    MsgBox "激活当前工作簿中的工作表sheet3"
    Worksheets("sheet3").Select
    MsgBox "同时选择工作簿中的工作表sheet2和sheet3"
    Worksheets(Array("sheet2", "sheet3")).Select
End Sub
示例说明：Activate方法只能激活一个工作表，而Select方法可以同时选择多个工作表。

--------------------------------------------------------------------------------
[示例7-02]
Sub SelectManySheet()
    MsgBox "选取第一个和第三个工作表."
    Worksheets(1).Select
    Worksheets(3).Select False
End Sub

--------------------------------------------------------------------------------
[示例8]获取当前工作表的索引号(Index属性)
Sub GetSheetIndex()
    Dim i As Long
    i = ActiveSheet.Index
    MsgBox "您正使用的工作表索引号为" & i
End Sub

--------------------------------------------------------------------------------
[示例9]选取前一个工作表(Previous属性)
Sub PreviousSheet()
    If ActiveSheet.Index <> 1 Then
      MsgBox "选取当前工作簿中当前工作表的前一个工作表"
      ActiveSheet.Previous.Activate
    Else
      MsgBox "已到第一个工作表"
    End If
End Sub
示例说明：如果当前工作表是第一个工作表，则使用Previous属性会出错。

--------------------------------------------------------------------------------
[示例10]选取下一个工作表(Next属性)
Sub NextSheet()
    If ActiveSheet.Index <> Worksheets.Count Then
      MsgBox "选取当前工作簿中当前工作表的下一个工作表"
      ActiveSheet.Next.Activate
    Else
      MsgBox “已到最后一个工作表”
    End If
End Sub
示例说明：如果当前工作表是最后一个工作表，则使用Next属性会出错。

--------------------------------------------------------------------------------
[示例11]工作表行和列的操作
[示例11-01]隐藏行
Sub HideRow()
    Dim iRow As Long
    MsgBox "隐藏当前单元格所在的行"
    iRow = ActiveCell.Row
    ActiveSheet.Rows(iRow).Hidden = True
    MsgBox "取消隐藏"
    ActiveSheet.Rows(iRow).Hidden = False
End Sub

--------------------------------------------------------------------------------
[示例11-02]隐藏列
Sub HideColumn()
    Dim iColumn As Long
    MsgBox "隐藏当前单元格所在列"
    iColumn = ActiveCell.Column
    ActiveSheet.Columns(iColumn).Hidden = True
    MsgBox "取消隐藏"
    ActiveSheet.Columns(iColumn).Hidden = False
End Sub

--------------------------------------------------------------------------------
[示例11-03]插入行
Sub InsertRow()
    Dim rRow As Long
    MsgBox "在当前单元格上方插入一行"
    rRow = Selection.Row
    ActiveSheet.Rows(rRow).Insert
End Sub

--------------------------------------------------------------------------------
[示例11-04]插入列
Sub InsertColumn()
    Dim cColumn As Long
    MsgBox "在当前单元格所在行的左边插入一行"
    cColumn = Selection.Column
    ActiveSheet.Columns(cColumn).Insert
End Sub

--------------------------------------------------------------------------------
[示例11-05]插入多行
Sub InsertManyRow()
    MsgBox "在当前单元格所在行上方插入三行"
    Dim rRow As Long, i As Long
    For i = 1 To 3
      rRow = Selection.Row
      ActiveSheet.Rows(rRow).Insert
    Next i
End Sub

--------------------------------------------------------------------------------
[示例11-06]设置行高
Sub SetRowHeight()
    MsgBox "将当前单元格所在的行高设置为25"
    Dim rRow As Long, iRow As Long
    rRow = ActiveCell.Row
    iRow = ActiveSheet.Rows(rRow).RowHeight
    ActiveSheet.Rows(rRow).RowHeight = 25
    MsgBox "恢复到原来的行高"
    ActiveSheet.Rows(rRow).RowHeight = iRow
End Sub

--------------------------------------------------------------------------------
[示例11-07]设置列宽
Sub SetColumnWidth()
    MsgBox "将当前单元格所在列的列宽设置为20"
    Dim cColumn As Long, iColumn As Long
    cColumn = ActiveCell.Column
    iColumn = ActiveSheet.Columns(cColumn).ColumnWidth
    ActiveSheet.Columns(cColumn).ColumnWidth = 20
    MsgBox "恢复至原来的列宽"
    ActiveSheet.Columns(cColumn).ColumnWidth = iColumn
End Sub

--------------------------------------------------------------------------------
[示例11-08]恢复行高列宽至标准值
Sub ReSetRowHeightAndColumnWidth()
    MsgBox "将当前单元格所在的行高和列宽恢复为标准值"
    Selection.UseStandardHeight = True
    Selection.UseStandardWidth = True
End Sub

--------------------------------------------------------------------------------
[示例12]工作表标签
[示例12-01] 设置工作表标签的颜色
Sub SetSheetTabColor()
MsgBox "设置当前工作表标签的颜色"
ActiveSheet.Tab.ColorIndex = 7
End Sub

--------------------------------------------------------------------------------
[示例12-01]恢复工作表标签颜色
Sub SetSheetTabColorDefault()
MsgBox "将当前工作表标签颜色设置为默认值"
ActiveSheet.Tab.ColorIndex = -4142
End Sub

--------------------------------------------------------------------------------
[示例12-03]交替隐藏或显示工作表标签
Sub HideOrShowSheetTab()
MsgBox "隐藏/显示工作表标签"
ActiveWindow.DisplayWorkbookTabs = Not ActiveWindow.DisplayWorkbookTabs
End Sub

--------------------------------------------------------------------------------
[示例13]确定打印的页数(HPageBreaks属性与VPageBreaks属性)
Sub PageCount()
    Dim i As Long
    i = (ActiveSheet.HPageBreaks.Count + 1) * (ActiveSheet.VPageBreaks.Count + 1)
    MsgBox "当前工作表共" & i & "页."
End Sub

--------------------------------------------------------------------------------
[示例14]保护/撤销保护工作表
[示例14-01]
Sub ProtectSheet()
MsgBox "保护当前工作表并设定密码"
ActiveSheet.Protect Password:="fanjy"
End Sub
示例说明：运行代码后，当前工作表中将不允许编辑，除非撤销工作表保护。

--------------------------------------------------------------------------------
[示例14-02]
Sub UnprotectSheet()
MsgBox "撤销当前工作表保护"
ActiveSheet.Unprotect
End Sub
示例说明：运行代码后，如果原保护的工作表设置有密码，则要求输入密码。

--------------------------------------------------------------------------------
[示例14-03]保护当前工作簿中的所有工作表
Sub ProtectAllWorkSheets()
    On Error Resume Next
    Dim ws As Worksheet
    Dim myPassword As String
    myPassword = InputBox("请输入您的密码" & vbCrLf & _
     "(不输入表明无密码)" & vbCrLf & vbCrLf & _
     "确保您没有忘记密码！", "输入密码")
    For Each ws In ThisWorkbook.Worksheets
      ws.Protect (myPassword)
    Next ws
End Sub

--------------------------------------------------------------------------------
[示例14-04]撤销对当前工作簿中所有工作表的保护
Sub UnprotectAllWorkSheets()
    On Error Resume Next
    Dim ws As Worksheet
    Dim myPassword As String
    myPassword = InputBox("请输入您的密码" & vbCrLf & _
      "(不输入表示无密码)", "输入密码")
    For Each ws In ThisWorkbook.Worksheets
      ws.Unprotect (myPassword)
    Next ws
End Sub

--------------------------------------------------------------------------------
[示例14-05]仅能编辑未锁定的单元格
Sub OnlyEditUnlockedCells()
Sheets("Sheet1").EnableSelection = xlUnlockedCells
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
示例说明：运行本代码后，在当前工作表中将只能对未锁定的单元格进行编辑，而其它单元格将不能编辑。未锁定的单元格是指在选择菜单“格式——单元格”命令后所弹出的对话框中的“保护”选项卡中，未选中“锁定”复选框的单元格或单元格区域。

--------------------------------------------------------------------------------
[示例15]删除工作表(Delete方法)
Sub DeleteWorksheet()
    MsgBox "删除当前工作簿中的工作表sheet2"
    Application.DisplayAlerts = False
    Worksheets("sheet2").Delete
    Application.DisplayAlerts = True
End Sub
示例说明：本示例代码使用Application.DisplayAlerts = False来屏蔽弹出的警告框。

--------------------------------------------------------------------------------
<一些编程方法和技巧>
[示例16] 判断一个工作表(名)是否存在
[示例16-01]
Sub testWorksheetExists1()
    Dim ws As Worksheet
    If Not WorksheetExists(ThisWorkbook, "sheet1") Then
      MsgBox "不能够找到该工作表", vbOKOnly
      Exit Sub
    End If
    MsgBox "已经找到工作表"
    Set ws = ThisWorkbook.Worksheets("sheet1")
End Sub
'- - - - - - - - - - - - - - - - - - -
Function WorksheetExists(wb As Workbook, sName As String) As Boolean
    Dim s As String
    On Error GoTo ErrHandle
    s = wb.Worksheets(sName).Name
    WorksheetExists = True
    Exit Function
ErrHandle:
    WorksheetExists = False
End Function
示例说明：在测试代码中，用相应的工作簿名和工作表名分别代替“ThisWorkbook”和“Sheet1”，来判断指定工作表是否在工作簿中存在。

--------------------------------------------------------------------------------
[示例16-02]
Sub testWorksheetExists2()
    If Not SheetExists("<工作表名>") Then
      MsgBox "<工作表名> 不存在!"
    Else
      Sheets("<工作表名>").Activate
    End If
End Sub
'- - - - - - - - - - - - - - - - - - -
Function SheetExists(SheetName As String) As Boolean
    SheetExists = False
    On Error GoTo NoSuchSheet
    If Len(Sheets(SheetName).Name) > 0 Then
      SheetExists = True
      Exit Function
    End If
NoSuchSheet:
End Function
示例说明：在代码中，用实际工作表名代替<>。

--------------------------------------------------------------------------------
[示例16-03]
Sub TestingFunction()
'如果工作表存在则返回True，否则为False
    '测试DoesWksExist1函数
    Debug.Print DoesWksExist1("Sheet1")
    Debug.Print DoesWksExist1("Sheet100")
    Debug.Print "-----"
    '测试DoesWksExist2函数
    Debug.Print DoesWksExist2("Sheet1")
    Debug.Print DoesWksExist2("Sheet100")
End Sub
‘- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Function DoesWksExist1(sWksName As String) As Boolean
    Dim i As Long
    For i = Worksheets.Count To 1 Step -1
      If Sheets(i).Name = sWksName Then
        Exit For
      End If
    Next
    If i = 0 Then
      DoesWksExist1 = False
    Else
      DoesWksExist1 = True
    End If
End Function
‘- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Function DoesWksExist2(sWksName As String) As Boolean
    Dim wkb As Worksheet
    On Error Resume Next
    Set wkb = Sheets(sWksName)
    On Error GoTo 0
    DoesWksExist2 = IIf(Not wkb Is Nothing, True, False)
End Function

--------------------------------------------------------------------------------
[示例17]排序工作表
[示例17-01]
Sub SortWorksheets1()
    Dim bSorted As Boolean
    Dim nSortedSheets As Long
    Dim nSheets As Long
    Dim n As Long
    nSheets = Worksheets.Count
    nSortedSheets = 0
    Do While (nSortedSheets < nSheets) And Not bSorted
      bSorted = True
      nSortedSheets = nSortedSheets + 1
      For n = 1 To nSheets - nSortedSheets
        If StrComp(Worksheets(n).Name, Worksheets(n + 1).Name, vbTextCompare) > 0 Then
          Worksheets(n + 1).Move Before:=Worksheets(n)
          bSorted = False
        End If
      Next n
     Loop
End Sub
示例说明：本示例代码采用了冒泡法排序。

--------------------------------------------------------------------------------
[示例17-02]
Sub SortWorksheets2()
    '根据字母对工作表排序
    Dim i As Long, j As Long
    For i = 1 To Sheets.Count
      For j = 1 To Sheets.Count - 1
        If UCase$(Sheets(j).Name) > UCase$(Sheets(j + 1).Name) Then
          Sheets(j).Move After:=Sheets(j + 1)
        End If
      Next j
    Next i
End Sub

--------------------------------------------------------------------------------
[示例17-03]
Sub SortWorksheets3()
'以升序排列工作表
    Dim sCount As Integer, i As Integer, j As Integer
    Application.ScreenUpdating = False
    sCount = Worksheets.Count
    If sCount = 1 Then Exit Sub
    For i = 1 To sCount - 1
      For j = i + 1 To sCount
        If Worksheets(j).Name < Worksheets(i).Name Then
          Worksheets(j).Move Before:=Worksheets(i)
        End If
      Next j
    Next i
End Sub
示例说明：若想排序所有工作表，将代码中的Worksheets替换为Sheets。

--------------------------------------------------------------------------------
[示例18]删除当前工作簿中的空工作表
Sub Delete_EmptySheets()
      Dim sh As Worksheet
      For Each sh In ThisWorkbook.Worksheets
        If Application.WorksheetFunction.CountA(sh.Cells) = 0 Then
          Application.DisplayAlerts = False
          sh.Delete
          Application.DisplayAlerts = True
        End If
      Next
End Sub