一个用来把一个工作簿按其中一个工作表关键词列拆分成多个工作簿的VBA代码

Option Explicit  Public Sub 分表循环()          '注意执行此宏会修改当前工作表,一定要在副本中运行     '执行此宏前一定要选中用作分表的关键字的整列     '工作表当中必须只有一个区域,一个Sheet中有多个区域是不行的     '拆分的工作表在当前工作簿文件夹下     '列中的关键字不要跟总表名重复          Dim isok As String          isok = MsgBox("该操作会删除该工作表,是否继续", vbYesNo)          If isok <> vbYes Then         Exit Sub     End If          Dim path As String          Dim fullPath As String          Dim columnIndex As Long          Dim keyAddress As String          Dim title As String          title = ActiveWindow.Caption          path = Application.ActiveWorkbook.path          fullPath = Application.ActiveWorkbook.FullName          keyAddress = Selection.item(2).address              columnIndex = ActiveSheet.range(keyAddress).column           While IsEmpty(ActiveSheet.range(keyAddress)) = False         ' 因为表格会被代码删除更新所以锚定单元格的值必须每次重新获取                  Call 另存为新表然后删除不需要的(columnIndex, path, ActiveSheet.range(keyAddress).Value2, fullPath, title)         Call 删除已经移除的(columnIndex, ActiveSheet.range(keyAddress).Value2)     Wend          MsgBox "拆分完成" End Sub     Private Sub 删除已经移除的(columnIndex As Long, key As String)     ActiveSheet.Cells.AutoFilter Field:=columnIndex, Criteria1:=key          Call 删除所有可见行除了标题          ActiveWorkbook.Save End Sub  Private Sub 删除所有可见行除了标题()      ActiveSheet.Cells.Rows("2:" & ActiveSheet.Rows.Count).SpecialCells(xlCellTypeVisible).Delete End Sub  Private Sub 另存为新表然后删除不需要的(columnIndex As Long, path As String, newName As String, fullPath As String, title As String)          Dim newPath As String          newPath = path & "" & newName & ".xlsx"               ActiveWorkbook.SaveAs Filename:= _         newPath, FileFormat:= _         xlOpenXMLWorkbook, CreateBackup:=False           ActiveSheet.Cells.AutoFilter Field:=columnIndex, Criteria1:="<>" & newName          Call 删除所有可见行除了标题          ActiveSheet.Cells.AutoFilter          ActiveWorkbook.Save          Dim newTitle As String          newTitle = ActiveWindow.Caption          Workbooks.Open (fullPath)          Windows(newTitle).Close          Windows(title).Activate      End Sub

 

推荐这些技术文章:

在VBA中使用Word格式

本主题包含Visual Basic部分中的任务相关的示例。
将格式应用于选择内容
下面的示例使用 Selection 属性将字符和段落格式应用于选定文本。 使用 Font 属性可访问字符格式设置属性和方法,使用 ParagraphFormat 属性可访问段落格式设置属性和方法。

Sub FormatSelection()
With Selection.Font
.Name = "Tim...

VBA 填充颜色和字体颜色

示例 1 - 在 Sub 中使用用户选择的 ( Ribbon ) 颜色您可能想知道为什么它没有作为变量/方法公开,以便能够像使用 Excel 中的任何其他对象一样访问,并且到目前为止(2020 年 7 月),我找不到任何官方文档来说明原因.在功能区的“主页”部分,您有两个方便的样本,分别是填充颜色和字体颜色。 色带上的色板能够访问这些而不是在脚本上使用颜色选择器不是很有用吗? 看看下面的脚...

Excel VBA 单元格内字符串截取

功能:v列有值的单元格内字符串截取

1 Sub Demo3()
2 Dim str
3 With ActiveSheet
4 For i = 2 To .Range("v65535").End(xlUp).Row
5 If Not Len(Trim(ActiveSheet.Cells(i, 22))) = 0 Then
6 ...

Excel VBA——如何快速将一个excel文件中的各个工作表分别保存成不同的工作簿

 
核心代码:

Sub SaveSheetAsWorkbook()
Dim theName As String '定义文件名变量
On Error GoTo Line1 '错误处理,报错直接跳出
For Each sht In Worksheets '循环本工作簿的各个工作表
sht.Copy '复制当前工作表
theName ...

VBA基础教程Day03: 单元格区域操作02

3-21.FIND单元格查找技术
Range.Find 方法
在区域中查找特定信息
语法
表达式.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
表达式  一个代表Range对象的变量。

Sub 查找最后一个单元格()

Set en...

Excel编程VBA图形Shape复选框的状态判断

Shape
https://docs.microsoft.com/zh-tw/office/vba/api/excel.shape
设置图形属性
ActiveSheet.Shapes(2).Line.Weight '当前工作表里图形(Shapes)集合里的第二个对象里的直线(Line)对象的粗细(Weight)属性

表单控件
根据图形的 Type 属性判断图形类型,如果是表单控件msoForm...

Excel VBA ——如何快速填充纸质登记表

场景:
一些个地方肯定有人特别喜欢用纸质单据记录,但是对于实际执行人来讲,大多数单据其实填写相当有规律,频繁使用手写简直是浪费时间,因此本示例尝试解决这个问题。
要点:
1. 图片电子签名
2. 常用数据快速填充
3. 一键打印并记录台账
效果如下:  1. 下拉选择常用信息,自动填充到左边的表格  2.点击打印按钮,自动将填写的信息写入台账,然后发送打印请求到打印机
&nb...

Excel VBA 从Excel中批量导出图片

Sub 产品图片导出重新对应命名()
Dim Ad$, FileName$, sfolder$, Shp As Shape, FSO
Application.ScreenUpdating = False
On Error Resume Next
Set FSO = CreateObject("Scripting.FileSystemObject")
...

【VBA】-添加文件路径以便于后面程序调用Source File或Template File

1.插入按钮1,选择对应执行的macro->Select_file
2.插入按钮2,选择对应执行的macro->Temp_file

Sub Select_file()
fileselection ActiveSheet.Range("b3")
End Sub
Sub Temp_file()
fileselection ActiveSheet.Range("b4")...

Excel-宏-将Excel多个工作表拆分成多个单独的Excel

1.原文件

2.拆分后

3.具体操作:打开需要拆分的excel,在任意工作表右击,点击“查看代码”

输入代码
Private Sub 分拆工作表()
Dim sht As Worksheet
Dim MyBook As Workbook
Set MyBook = ActiveWorkbook
For Each sht In MyBoo...

文章标题:一个用来把一个工作簿按其中一个工作表关键词列拆分成多个工作簿的VBA代码
文章链接:https://www.dianjilingqu.com/441.html
本文章来源于网络,版权归原作者所有,如果本站文章侵犯了您的权益,请联系我们删除,联系邮箱:saisai#email.cn,感谢支持理解。
THE END
< <上一篇
下一篇>>