2021-10-14 最近给同事帮忙写了一个Excel宏

之前参与的Java项目的后续。基本功能是这样，有这么一个Excel文件有几个（固定的）页面，每个页面都有最后一列名为“分类”。现在要求对于每种不同的分类，创建一个新的Excel文件并写入分类列为该值的行（不包含分类列）。写得很累所以懒得说明代码了。有空再补吧。

Sub 宏1()
'
' 宏1 宏
''Dim sheets(1 To 3) As WorksheetSet sheets(1) = Worksheets("单选题")Set sheets(2) = Worksheets("多选题")Set sheets(3) = Worksheets("判断题")Dim TypeColumnNumber(1 To 3) As IntegerDim dictionary                   'Create a variableSet dictionary = CreateObject("Scripting.Dictionary")For K = 1 To 1  '测试 1 To 3Dim i As Integeri = 1Do While (sheets(K).Cells(1, i) <> "分类" And sheets(K).Cells(1, i) <> "")i = i + 1LoopIf sheets(K).Cells(1, i) = "" ThenExit ForEnd IfDim j As Integerj = 2Do While (sheets(K).Cells(j, i) <> "")Dim category As Stringcategory = sheets(K).Cells(j, i)If dictionary.Exists(category) ThenDim RowNums As CollectionSet RowNums = dictionary.Item(category)RowNums.Add (j)ElseDim RowNumsNew As New CollectionRowNumsNew.Add (j)dictionary.Add category, RowNumsNewSet RowNumsNew = NothingEnd Ifj = j + 1LoopTypeColumnNumber(K) = iNextDim typeStringDim workbookName As StringworkbookName = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1)For Each typeString In dictionary.Keys()Dim NewBook As WorkbookSet NewBook = Workbooks.AddWith NewBook.SaveAs Filename:=workbookName + "-" + typeString + ".xlsx"End WithNewBook.Worksheets.Add.Name = "※使用说明"NewBook.Worksheets.Add.Name = "判断题"NewBook.Worksheets.Add.Name = "多选题"NewBook.Worksheets.Add.Name = "单选题"NewBook.Worksheets("Sheet1").DeleteNewBook.Worksheets("Sheet2").DeleteNewBook.Worksheets("Sheet3").Deletesheets(1).Range("A1", sheets(1).Cells(1, TypeColumnNumber(1) - 1)).Copy _Destination:=NewBook.Worksheets("单选题").Rows(1)Dim RowNumCollection As CollectionSet RowNumCollection = dictionary.Item(typeString)Dim RowNumDim NewRowNum As IntegerNewRowNum = 2For Each RowNum In RowNumCollectionsheets(1).Range(sheets(1).Cells(RowNum, 1), sheets(1).Cells(RowNum, TypeColumnNumber(1) - 1)).Copy _Destination:=NewBook.Worksheets("单选题").Cells(NewRowNum, 1)NewRowNum = NewRowNum + 1NextNext
End Sub

2021-10-14 最近给同事帮忙写了一个Excel宏相关推荐

电动力学每日一题 2021/10/14
电动力学每日一题 2021/10/14 (a) Define r∣∣=xx^+yy^\textbf r_{||}=x\hat x+y\hat yr∣∣=xx^+yy^, r∣∣=x2+y2r_{| ...
[2021.10.14][Android P]OpenCamera详细分析(Camera2+Hal3)
因为工作涉及到Android Camera系统的问题,本文整理了在Android P上讲解OpenCamera比较详细的文章,结合Andriod P源码,以架构图.UML顺序图.UML类图和关键代码走 ...
2021/10/14程式培力刷題記錄
刷題記錄 A CodeForces 50A Domino piling #include<bits/stdc++.h> using namespace std; int main() {i ...
2021.10.14股票小计
今天大盘还是缩量,没有突破万亿,市场情绪还是比较低迷,大盘走势也比较平淡, 持有的股票中宋城演艺和上海机场分别收涨4.62个点和5.47个点,证券今天收盘收跌0.11个点,华林证券收跌0.73个点,钢 ...
【用java写的一个excel签到表】
画页面 import cn.hutool.core.date.DateUtil; import org.apache.poi.xssf.usermodel.XSSFWorkbook;import ja ...
2021.10.25-10.31 AI行业周刊（第69期）：AI进化之路
本周<Opencv基础及AI项目实战>以及<Pytorch模型推理及多任务通用范式>两门课程已经完结. 两门课程中,针对所有完成作业的同学,都颁发了毕业证书. 并且对于完成比较 ...
Python 最近两条好消息：①TIOBE排名超过C和Java②新版本发布3.10.0，还有今天刚发布的《What’s New in Python(2021.10.15)》
来自TIOBE的最新10月份统计数据显示,Python首次超越Java.JavaScript.C语言等,成为最受欢迎的编程语言.TIOBE过去20年一直在追踪编程语言的受欢迎程度,其数据来自于对25个 ...
博客新功能上线，可导出PDF……【2021.12.14】
hello,大家好,这里是「CSDN产品周报」第21期.本次更新主要涉及首页榜单.博客.问答,具体细节请往下看. 一.CSDN榜单优化 1.排行榜导航栏从右侧移动到左侧 2.新增「原力月榜」,选取全站 ...
2021.8.8 ~ 2021.8.14 在SSL集训总结（Week 1 已更完）
集训总结前言因为疫情,就回到SSL集训了 (可能有点长,右边有目录) 后续,第二周 2021.8.15 ~ 2021.8.25 在SSL集训总结(Week 2)(更新ing) Day -1(8.7 ...

2021-10-14 最近给同事帮忙写了一个Excel宏

2021-10-14 最近给同事帮忙写了一个Excel宏相关推荐

最新文章

热门文章