多语言展示
当前在线:1237今日阅读:84今日分享:32

Excel总表按条件批量拆分多表(一表拆分多表)

修法布施得聪明智慧,多分享让生活更美好。下面以实例分享一表根据条件批量拆分多表,如达到举一返三,方便大家工作利用,提高工作效率。
工具/原料
1

Microsoft Office Excel 2007

2

Excel VBA

实例问题

因工作需要,需要把村里有所有人的表格,按户拆分成多个工作表,每个户一个工作表,sheet名字是户主的名字,全村三千多人,一户一户的复制,太慢了,怎么快速拆开,拆成图片3那样的一户一个sheet工作表。

处理方法/步骤
1

首先打开上例文件,如下图。

2

然后按下快捷键ALT+F11打开VBA(宏)编辑界面,然后点菜单栏【插入】下拉中列表中点【模块(M)】如图。

3

然后插入了一个模块1,在代码框中复制如下代码:Option Base 1Sub 批量拆分表()'2020-2-13 21:23:48  Dim r As Long, mb(), i As Long, j As Long, wt1 As Worksheet, wt2 As Worksheet, k1 As Long, k2 As Long  r = Cells(Rows.Count, 3).End(xlUp).Row  j = 0  Set wt1 = ActiveSheet  ReDim mb(r, 2)  For i = 5 To r    If Cells(i, 2).Value = '户主' Then        j = j + 1        mb(j, 1) = i        mb(j, 2) = Cells(i, 3).Value    End If  Next i  wt1.Copy After:=wt1  Set wt2 = ActiveSheet  Rows('5:' & r).Delete  For i = 1 To j      wt2.Copy After:=Sheets(Sheets.Count)      ActiveSheet.Name = mb(i, 2)      If i = j Then           wt1.Rows(mb(i, 1) & ':' & r).Copy ActiveSheet.Cells(5, 1)      Else           wt1.Rows(mb(i, 1) & ':' & mb(i + 1, 1) - 1).Copy ActiveSheet.Cells(5, 1)      End If     k1 = 5     k2 = 0     Do While Cells(k1, 1).Value <> ''        k2 = k2 + 1        Cells(k1, 1).Value = k2        k1 = k1 + 1     Loop  Next i  wt2.DeleteEnd Sub

4

以上操作动态过程如下:

5

回到工作表窗口,运行【批量拆分表】宏(菜单栏中点【视图】中下列表中【宏】列表【查看宏(V)】打开宏对方框,选该宏名),运行过程如下图。

6

写这篇经验正是我们和新型冠状病毒疫作斗挣。武汉加油,你们并不孤单,全国人民和你们战斗在一起!中国加油!我们有坚强的中国共产党领导,有一支经过历史考验的科学家、医疗队伍和管理经验的信得过队伍,我们会向全世界展示能战胜任何艰难困阻的中国!

7

如果觉得这篇经验帮到了您,请点击下方的 “投票点赞' 或者“收藏”支持我!还有疑问的话可以点击下方的 “我有疑问”,谢谢啦!

推荐信息