【VBA】VBA编写的,将一列中相同的内容的行提取出来单独生成文件
2024-09-28 20:36:26
数据如上图所示,点击RUN后的运行结果如下:
得到该文件夹,文件夹内容如上图。
代码如下:
Private Sub Command_OLIVER()
Dim arr
arr = Range("A1:C" & [a65536].End(3).Row) Dim i As Long, wName As String, wPath As String
wName = "分类汇总" & Format(Now(), "hhmmss")
Dim dc As Object, wb As Workbook, n As Long
Set dc = CreateObject("Scripting.dictionary") wPath = ThisWorkbook.Path & "\" & wName
MkDir wPath
For i = 2 To UBound(arr)
If Not dc.exists(arr(i, 1)) Then
Set wb = Workbooks.Add
wb.SaveAs wPath & "\" & arr(i, 1) & ".xls" '001
wb.Sheets(1).Name = arr(i, 1)
'填写表头
wb.Sheets(1).[a1] = arr(1, 1)
wb.Sheets(1).[b1] = arr(1, 2)
wb.Sheets(1).[c1] = arr(1, 3)
dc.Add arr(i, 1), ""
End If
With Workbooks(arr(i, 1) & ".xls").Sheets(1) '002
n = .[a65536].End(3).Row + 1
.Cells(n, 1) = arr(i, 1)
.Cells(n, 2) = arr(i, 2)
.Cells(n, 3) = arr(i, 3)
End With
Next Dim ar
ar = dc.keys
For i = 0 To UBound(ar)
Workbooks(ar(i) & ".xls").Close True '003
Next
End Sub
调用该sub
Sub 调用()
Command_OLIVER
End Sub
注意:必须在同一模块中call该sub,因为上述sub为私有的,局部方法.
最新文章
- python netwokx环境搭建
- Java初识
- Shell命令_正则表达式
- dataguard 归档丢失(主库中无此丢失归档处理),备库基于SCN恢复
- 使用RAML描述API文档信息的一些用法整理
- [AX]AX2012 Number sequence framework :(三)再谈Number sequence
- C++ new(2)
- 用excel处理重复数据
- JS同名方法,
- QStyle 新风格的实现
- JSP学习笔记(二):Tomcat服务器的安装及配置
- 2014第8周三杂记及web标准学习
- 虚拟机下克隆3个centos系统并配置IP访问网络(转载)
- 排序算法Java实现(冒泡排序)
- 如何测试一个WEB的输入框?
- ProxySQL 读写分离实践
- 【Swift】swift中使用kvc赋值的时候,注意事项
- Python---函数的相关知识点总结一:
- cookie设置和清除,解决跨目录读取不到cookie值
- Last Day in Autodesk