文档章节

使用VBA将Excel工作表分割成多个文件

abing_hu
 abing_hu
发布于 2013/12/27 22:16
字数 1041
阅读 9491
收藏 11

##问题描述 有一个表格,具体数据如下图所示。这里需要按城市(即B列数据)对表格进行拆分,拆分出多个以城市名称命名的xlsx文件,每个xlsx文件都只包含当前城市的数据。 表格数据

##相关资料 之前没有接触过Excel相关的编程,也没有学习过VB语言,完全是摸着石头过河。在这里把期间使用过的一些资料罗列下,方便以后再次用到的时候,可以快速再捡起来。

  1. Excel 2007 VBA Macro Programming 这个是英文版的电子书,当初在皮皮书屋(皮皮书屋是好东西,你懂的)上随便找的,做为我VBA的入门书籍。主要从这本书里学习了VBA的对象模型,几个常用的对象,Application、Workbook、Worksheet、Range。这本书有个好的地方就是在书的后面有个索引,可以快速地查看自己想了解的内容。这本书也有个大的缺陷,就是内容讲得还不够详细具体,往往找到了自己想了解的内容,想深入了解下各种操作,结果发现它讲完了。

  2. 在线教程 这是个非常好的网站,里面包含了很多简单的例子及代码。当想要实现某个简单地操作的时候,可以先到这里来找找看有没有相应的实例。有一点搞不明白的就是,明明是中文网站,怎么贴的图片里的Excel都是日文的(好吧,不深究了)。对于新手来说非常有用,推荐之。

  3. Excel函数在线查询 最权威的Excel函数查询网站,好吧,其实就是微软的MSDN啦。虽然说MSDN的文档有时候的确搞不清楚它在讲什么,但是它还是最详细的。 ##代码 好吧,不废话了,直接上代码。

    <!-- lang: vb -->

     Sub XXX_Click()
    
         '输入用户想要拆分的工作表
         Dim sheet_name
         sheet_name = Application.InputBox("请输入拆分工作表的名称:")
         Worksheets(sheet_name).Select
    
         '输入获取拆分需要的条件列
         Dim col_name
         col_name = Application.InputBox("请输入拆分依据的列号(如A):")
    
         '输入拆分的开始行,要求输入的是数字
         Dim start_row As Integer
         start_row = Application.InputBox(prompt:="请输入拆分的开始行:", Type:=1)
    
         '暂停屏幕更新
         Application.ScreenUpdating = False
    
         '工作表的总行数
         Dim end_row
         end_row = Worksheets(sheet_name).Range("A65536").End(xlUp).Row
    
         '遍历计算所有拆分表,每个拆分表的格式为"表名称,表行数"
         '对于二维数组,ReDim只能扩充最后一维,因此sheet_map行不变,扩充列
         Dim sheet_map(), sheet_index
         ReDim sheet_map(1, 0)
         sheet_map(0, 0) = Range(col_name & start_row).Value
         sheet_map(1, 0) = 1
         sheet_index = 0
    
         With Worksheets(sheet_name)
             Dim row_count, temp, i
             row_count = 0
             For i = start_row + 1 To end_row
                 temp = Range(col_name & i).Value
                 If temp = Range(col_name & (i - 1)).Value Then
                     sheet_map(1, sheet_index) = sheet_map(1, sheet_index) + 1
                 Else
                     ReDim Preserve sheet_map(1, sheet_index + 1)
                     sheet_index = sheet_index + 1
                     sheet_map(0, sheet_index) = temp
                     sheet_map(1, sheet_index) = 1
                 End If
             Next
         End With
    
         '根据前面计算的拆分表,拆分成单个文件
         Dim row_index
         row_index = start_row
         For i = 0 To sheet_index
             Workbooks.Add
             '创建最终数据文件夹
             Dim dir_name
             dir_name = ThisWorkbook.Path & "\拆分出的表格\"
             If Dir(dir_name, vbDirectory) = "" Then
                 MkDir (dir_name)
             End If
             '创建新工作簿
             Dim workbook_path
             workbook_path = ThisWorkbook.Path & "\拆分出的表格\" & sheet_map(0, i) & ".xlsx"
             ActiveWorkbook.SaveAs workbook_path
             ActiveSheet.Name = sheet_map(0, i)
             '激活当前工作簿,ThisWorkbook表示当前跑代码的工作簿
             ThisWorkbook.Activate
    
             '拷贝条目数据(即最前面不需要拆分的数据行)
             Dim row_range
             row_range = 1 & ":" & (start_row - 1)
             Worksheets(sheet_name).Rows(row_range).Copy
             Workbooks(sheet_map(0, i) & ".xlsx").Sheets(1).Range("A1").PasteSpecial
             '拷贝拆分表的专属数据
             row_range = row_index & ":" & (row_index + sheet_map(1, i) - 1)
             Worksheets(sheet_name).Rows(row_range).Copy
             Workbooks(sheet_map(0, i) & ".xlsx").Sheets(1).Range("A" & start_row).PasteSpecial
             row_index = row_index + sheet_map(1, i)
    
             '保存文件
             Workbooks(sheet_map(0, i) & ".xlsx").Close SaveChanges:=True
         Next
    
         '进行屏幕更新
         Application.ScreenUpdating = True
    
         MsgBox "拆分工作表完成"
    
       End Sub
    

似乎,博客的代码着色功能不是好呀,看着让人感觉好费力,再给大家上两张看着舒服的图片吧。 代码图1 代码图2

© 著作权归作者所有

abing_hu
粉丝 11
博文 29
码字总数 7098
作品 0
杭州
后端工程师
私信 提问
加载中

评论(2)

竹林里桃之夭夭
竹林里桃之夭夭
为什么我运行的时候显示下标越界呢
qq162191080
qq162191080
学习学习
VBA的编程环境VBE的窗口介绍

1、打开方法 打开excel应用程序,在“开发工具”选项卡下点击“Visual Basic”按钮或者直接按下快捷键Alt+F11即可打开VBE窗口。 2、VBE窗口组成 (1)菜单栏是VBE窗口最重要的组成,包括文件...

nooname
2018/05/10
0
0
熟悉VBA的编程环境——VBE:各窗口的功能介绍博客

窗口中主要包括菜单栏、工具栏、工程资源管理器、代码窗口、属性窗口、立即窗口、监视窗口等。这些窗口模板可以通过视图菜单中的相应命令进行显示和隐藏。以下对VBE窗口中主要模板的简单介绍...

musifang
2018/05/10
0
0
学以致用——使用VBA实现创建新记录时自动添加时间戳(Add timestamp when adding new record in Excel)

今天又实现了一个“梦寐以求”的功能:为Excel中创建的新记录自动添加时间戳。 虽然这是个简单需求,但是我却等了很久。 虽然代码不难,但是调试却花了我一个多小时,特次分享给所有有缘之人...

hpdlzu80100
2018/05/30
0
0
即使你是新手看完也能轻松完成Excel合并表格!

谈到表格合并大家首先就会认为很困难,可能需要VBA编程才能完成。现在一些所谓的专家唯VBA的论调,导致我们很多初学者对某些问题望而生畏。个人观点会VBA不是什么牛逼的事情。能用函数解决的...

小新
2017/09/09
0
0
Power query数据处理-从Mysql数据库导入数据至Excel - 知乎

文章略长,先放效果! 作为最简单上手的数据处理工具,Excel在数据清洗、分析上作用非凡。有一个非常常见的场景,我们需要把写好sql语句从数据库导出为xlsx文件然后在excel中做进一步处理,是...

简快EXCEL 之 Power BI 建模分析
2019/10/21
0
0

没有更多内容

加载失败,请刷新页面

加载更多

Numpy处理图片方法

在进行图像领域的深度学习的时候经常需要对图片进行处理,包括图像的翻转,压缩,截取等,一般都是用Numpy来处理。处理起来也很方便。 In[3] # 导入需要的包 import numpy as np import matp...

北方的郎
18分钟前
7
0
AMD集中擢升高管:从Intel挖了个高手

  1 月 17 日,AMD 官方宣布多项人事升迁、新人任命,擢升了四位高级副总裁:   AMD 同时还宣布, 聘请行业资深人士 Daniel McNamara 出任高级副总裁兼服务器业务部总经理,负责在第二代...

水果黄瓜
22分钟前
6
0
什么是泛型?

一、泛型的概念 泛型是 Java SE5 出现的新特性,泛型的本质是类型参数化或参数化类型,在不创建新的类型的情况下,通过泛型指定的不同类型来控制形参具体限制的类型。 二、泛型的意义 一般的...

hncboy
57分钟前
7
0
dynamic-connectivity 动态连通性问题之 quick-union 算法

quick-union 的思想是:若对象 p 的 root_id 和对象 q 的 root_id 相等,则认为 p 和 q 连通。 若要将对象 p 和对象 q 连通(已知两对象未连通),则将 p 的 root_id 的值设为 q 的 root_id ...

Phpythoner_Alei
今天
51
0
OSChina 周六乱弹 —— 实在选不出来就唱国歌

Osc乱弹歌单(2020)请戳(这里) 【今日歌曲】 @花间小酌 :#今日歌曲推荐# 分享阿冗的单曲《你的答案》。--祝大家在2020年都找到自己答案。 《你的答案》- 阿冗 手机党少年们想听歌,请使劲...

小小编辑
今天
285
6

没有更多内容

加载失败,请刷新页面

加载更多

返回顶部
顶部