VBA学习笔记之工作表

Sub 遍历sheets下的所有对象()
For Each shs In Sheets
    k = k + 1
    Cells(k, 1) = shs.Name
Next
End Sub

Sub 遍历worksheets下的所能对象()
For Each shs In Worksheets
    k = k + 1
    Cells(k, 2) = shs.Name
Next
End Sub

两段代码的区别在于一个是sheets下的所有对象，一个是worksheets下的所有工作表对象

 

判断工作表存在与否：

Sub 工作表存在与否()
Dim sn$
For Each sht In Sheets
    sn = sht.Name
    If sn = "我的工作表" Then
        MsgBox "存在"
        Exit Sub
    End If
Next
    MsgBox "不存在"
End Sub

Sub 工作表存在与否1()
Dim sn$
For i = 1 To Sheets.Count
        a = Sheets(i).Name
    If Sheets(i).Name = "我的工作表" Then
        MsgBox "存在"
        Exit Sub
    End If
Next
     MsgBox "不存在"
End Sub

添加工作表的方法：

' Sheets.Add 方法
' 表达式.Add(Before, After, Count, Type)
' XlSheetType 常量之一：
' xlWorksheet 工作表
' xlChart 图表
' xlExcel4MacroSheet 宏表
' xlExcel4IntlMacroSheet 对话框
' 默认值为 xlWorksheet。

Sub 新建sheets()
'Sheets.Add
'Sheets.Add Sheets("abc")'在abc工作表前面添加
'Sheets.Add , Sheets("abc")'在abc工作表后面添加
'Sheets.Add after:=Sheets("abc")'同上
'Sheets.Add Count:=2'新建两个工作表
'Sheets.Add , , 2'同上
Sheets.Add , , , xlChart'新建图表
End Sub

以上格式都可以新建工作表，注意新建的工作表位置有所不同

'如果想批量新建工作表，可以结果循环来制作
Sub 新建1到12月份的工作表()
Dim j%
For j = 12 To 1 Step -1'因为默认添加的工作表是在当前工作表的前面
    Sheets.Add.Name = j & "月"
Next
End Sub

'删除工作表
Sub 删除sheet()
On Error Resume Next
Application.DisplayAlerts = False'去除删除时的警告提示
Dim i%
For i = 1 To 12
    Sheets(i & "月").Delete
Next
Application.DisplayAlerts = True'删除完成后恢复警告提示
End Sub

　　

'表达式.Move(Before, After)
'表达式.copy(Before, After)

Sub 移动()
Sheet1.Move , Sheet3
End Sub

Sub 复制()
Sheet1.Copy Sheets(Sheets.Count)
End Sub

Sub 实例()
Dim i%, sth As Worksheet
For i = 1 To 12
    Set sth = Sheets.Add
          sth.Move after:=Sheets(Sheets.Count)
          sth.Name = i & "月"
Next
End Sub

 重点来了：拆分工作簿

把当前工作簿下的所有工作表依次拆分并存储为不同的工作簿，名字分别为之前的工作表名

重点运用COPY的跨工作簿特性，用到工作簿的SaveAs方法

给出代码

 

Sub 拆分工作簿()
Dim wb As Workbook, k
k = 0
For Each sh In ThisWorkbook.Sheets
Application.DisplayAlerts = False
    Set wb = Workbooks.Add
    k = k + 1
    ThisWorkbook.Sheets(k).Copy wb.Sheets(1)
    Path = ThisWorkbook.Path & "\" & wb.Sheets(1).Name & ".xlsx"
    wb.SaveAs Path
    wb.Close
Next
Application.DisplayAlerts = True
End Sub

 

　　

 

　PS:　Workbooks(1).Sheets(k).Copy Workbooks(2).Sheets(1)把当前工作簿下工作表复制给新建的工作簿下sheets1的前面（即跨工作簿复制）

　PS:　SaveAs后面跟完整的路径

 

转载于:https://www.cnblogs.com/gilgamesh-hjb/p/7294295.html