个人中心
gpt4 book ai didi

VBS实现工作表按指定表头自动分表

转载 作者：qq735679552 更新时间：2022-09-29 22:32:09 24 4
gpt4 key购买 nike

CFSDN坚持开源创造价值，我们致力于搭建一个资源共享平台，让每一个IT人在这里找到属于你的精彩世界.

这篇CFSDN的博客文章VBS实现工作表按指定表头自动分表由作者收集整理，如果你对这篇文章有兴趣，记得点赞哟.

在我们实际工作中经常遇到将工作表按某一表头字段分开的情况，我们一般的做法是先按指定表头排序然后分段复制粘贴出去，不但麻烦还很容易搞错。 下面的VBS脚本就是实现的工作表按指定表头（由用户选择）自动分表功能。需要的朋友只要将要操作的工作表拖放到脚本文件上即可轻松实现工作表分表（暂时只适用于xp系统）:

复制代码 代码如下

'拖动工作表至VBS脚本实现按指定表头自动分表 On Error Resume Next If WScript.Arguments(0) = "" Then WScript.Quit Dim objExcel, ExcelFile, MaxRows, MaxColumns, SHCount ExcelFile = WScript.Arguments(0) If LCase(Right(ExcelFile,4)) <> ".xls" And LCase(Right(ExcelFile,4)) <> ".xls" Then WScript.Quit Set objExcel = CreateObject("Excel.Application") objExcel.Visible = False objExcel.Workbooks.Open ExcelFile '获取工作表初始sheet总数 SHCount = objExcel.Sheets.Count '获取工作表有效行列数 MaxRows = objExcel.ActiveSheet.UsedRange.Rows.Count MaxColumns = objExcel.ActiveSheet.UsedRange.Columns.Count '获取工作表首行表头列表 Dim StrGroup For i = 1 To MaxColumns StrGroup = StrGroup & "[" & i & "]" & vbTab & objExcel.Cells(1, i).Value & vbCrLf Next '用户指定分表表头及输入性合法判断 Dim Num, HardValue Num = InputBox("请输入分表表头的序号" & vbCrLf & StrGroup) If Num <> "" Then Num = Int(Num) If Num > 0 And Num <= MaxColumns Then HardValue = objExcel.Cells(1, Num).Value Else objExcel.Quit Set objExcel = Nothing WScript.Quit End If Else objExcel.Quit Set objExcel = Nothing WScript.Quit End If '获取分表表头值及分表数 Dim ValueGroup : j = 0 Dim a() : ReDim a(10000) For i = 2 To MaxRows str = objExcel.Cells(i, Num).Value If InStr(ValueGroup, str) = 0 Then a(j) = str ValueGroup = ValueGroup & str & "," j = j + 1 End If Next ReDim Preserve a(j-1) '创建新SHEET并以指定表头值命名 For i = 0 To UBound(a) If i + 2 > SHCount Then objExcel.Sheets.Add ,objExcel.Sheets("sheet" & i + 1),1,-4167 Next For i = 0 To UBound(a) objExcel.Sheets("sheet" & i + 2).Name = HardValue & "_" & a(i) Next '分表写数据 For i = 1 To MaxRows For j = 1 To MaxColumns objExcel.sheets(1).Select str = objExcel.Cells(i,j).Value If i = 1 Then For k = 0 To UBound(a) objExcel.sheets(HardValue & "_" & a(k)).Select objExcel.Cells(i,j).Value = str objExcel.Cells(1, MaxColumns + 1).Value = 1 Next Else objExcel.sheets(HardValue & "_" & objExcel.Cells(i,Num).Value).Select If j = 1 Then x = objExcel.Cells(1, MaxColumns + 1).Value + 1 objExcel.Cells(x ,j).Value = str If j = MaxColumns Then objExcel.Cells(1, MaxColumns + 1).Value = x End If Next Next For i = 0 To UBound(a) objExcel.sheets(HardValue & "_" & a(i)).Select objExcel.Cells(1, MaxColumns + 1).Value = "" Next objExcel.ActiveWorkbook.Save objExcel.Quit Set objExcel = Nothing WScript.Echo "提示：对" & ExcelFile & "的分表操作完成" 。

最后此篇关于VBS实现工作表按指定表头自动分表的文章就讲到这里了,如果你想了解更多关于VBS实现工作表按指定表头自动分表的内容请搜索CFSDN的文章或继续浏览相关文章，希望大家以后支持我的博客！ 。

24 4 0
文章推荐： Java最常用的6个简单的计算题
文章推荐： SpringMVC上传文件的两种方法
文章推荐： 使用maven构建java9 service实例详解
文章推荐： VBS 硬盘读写统计(分区读写统计)
qq735679552
个人简介

我是一名优秀的程序员,十分优秀！

滴滴打车优惠券免费领取
滴滴打车优惠券
全站热门文章
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com