excel拆分工作表方法之函数和VBA

Office办公, 幻灯片 4 周前 回复

, , ,

“总-分式套表”,好像是每个行业每个统计岗都会遇到的表格形式,十分的普遍,我们在日常工作中,也经常需要把各种表格,拆分又合并,合并再拆分,这就是“分久必合,合久必分”的千古铁律。可是如果我们只会筛选后复制、粘贴,确实效率低下,那么这篇文章就给大家带来几种拆分与合并的操作方法,希望在工作中能够帮到同学们。

一、总表拆分为工作表——函数流
下图是比较常见数据,我们现在的需求:按照总表中的供应商数据做出各个分表,把数据分别做到每个对应供应商的工作表中。

总表拆分为工作表——函数流
总表拆分为工作表——函数流

步骤1:当我们使用函数拆分工作表时,需要先“手工”创建各个分表。我们先确定表中的供应商名称分别是:“永达”,“安达”,“洋子”三家公司,然后手动添加一个名为《永达》的分表:

步骤2:制作供应商分表的“表头”。分表的表头可以和总表的一样,也可以不一样,具体问题具体分析,但是一定要注意,在分表中出现的字段一定是可以从总表中引用的,或者是可以通过数据计算的。

步骤3:在总表中制作辅助列,作为分表引用的“关键词”。

(“关键词”的作用是用于唯一地标识表中的某一条记录或某一个字段属性,具有唯一性的原则。)

A列函数:

=I2&COUNTIF($I$2:I2,I2) 

通过COUNTIF函数和区域“混合引用”的方法,得到每个供应商,在总表中出现的顺序号,再与供应商名连接,形成一个新的引用关键字。此类引用方法在之前的教程中介绍过,小伙伴们可以点击教程《同样是countifs函数,为什么同事却使得比你好?原因在这里!》学习,此处不做赘述了。

步骤4:在分表中制作引用数据的函数。当仁不让,我们一定会使用到常用函数VLOOKUP。
《永达》分表中A6单元格函数:

=IFERROR(VLOOKUP($B$2&ROW(A1),总表!$A$1:$K$50000,MATCH(A$5,总表!$A$1:$K$1,0),0),"") 

这是一个典型的IFERROR+VLOOKUP+MATCH函数的嵌套使用:

$B$2&ROW(A1)是供应商名称&行号,这样就和我们刚才在总表中做的辅助列字段相呼应,可以作为VLOOKUP函数的引用标准。

用MATCH函数得到表头字段在总表中的序列号,可以确定VLOOKUP函数引用的第几列的数据。

最后再用IFERROR函数规避#N/A值。

同学们可以看到这里用了很多的“区域引用技巧”,这是函数应用基础的一部分,就不在这里多说了,不会的话赶紧在部落窝补补课。

输入函数后,右拉填充,再下拉填充,一个分表的自动化拆分就做好了。

“小常识”:

这里介绍一个右拉、再下拉填充公式的快捷方式,在A6单元格输入公式后,接着在名称框中输入A6:J10000,按回车键选中需要填充的区域,再按CTRL+D组合键向下填充,再按CTRL+R组合键向右填充,完工。

二、总表拆分为工作表——VBA流
不废话,先来一个效果图:

总表拆分为工作表——VBA流
总表拆分为工作表——VBA流

是不是很方便?而且每次修改、删除、增加总表记录的时候,再次点击按钮就可以自动更新数据!下面我们就一起来看看操作方法吧~

步骤1:按ALT+F11组合键,打开VBE界面;

步骤2:在左边工程窗口处,单击鼠标右键,在弹出的菜单中选择“插入”——“模块”;

步骤3:双击新生成的模块,在右侧代码区,输入如下代码:

Sub 拆分表()
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  On Error Resume Next
  Dim arr, brr, d
’“总表”是作者测试数据的工作表名称,如果你的总表工作表名称是其他的,如:XXX,把代码中所有的“总表”替换(CTRL+H)成XXX即可。
  a = Sheets("总表").[B65000].End(3).Row
’A2:J & a 是作者测试数据中的区域,大家可以改成自己的列表范围
  arr = Sheets("总表").Range("A2:J" & a)
  Set d = CreateObject("scripting.dictionary")
  For i = 1 To UBound(arr)
’为什么是arr(i,8)呢?因为我们是按照数据范围中的第8列内容也就是“供应商”列拆分总表。大家可以按照自己的需要改成某列号即可,下面的arr(i,8)都是这样的修改方式。
    d(arr(i, 8)) = d(arr(i, 8)) + ""
  Next i
  x = Sheets.Count
  For j = x To 1 Step -1
    If Sheets(j).Name <> "总表" Then
      Sheets(j).Delete
    End If
  Next j
  x = Sheets.Count
  For Each dic In d
    ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
    Sheets.Add after:=Sheets(x)
    x = x + 1
    Sheets(x).Name = dic
    For i = 1 To UBound(arr)
      If arr(i, 8) = dic Then
        k = k + 1
        For j = 1 To UBound(arr, 2)
          brr(k, j) = arr(i, j)
        Next j
      End If
    Next i
Sheets("总表").Range("1:1").Copy Sheets(x).Range("1:1")
’ Range("A2"),是作者被粘贴区域的首个单元格,如果大家需要从其他部分粘贴,就把这里改一下。
    Sheets(x).Range("A2").Resize(UBound(brr), UBound(brr, 2)) = brr
    Erase brr
    k = 0
  Next
End Sub

步骤4:运行代码,测试代码是否运行正常。

步骤5:如果测试代码无误,将.XLSX文件另存为.XLSM文件(启用宏的EXCEL工作薄)。作者E图表述的很多学生在初学VBA的时候,经常会忘记另存为.XLSM文件,虽然也能保存,但是保存的是工作表区域的数据,VBE界面的代码是没有被保存的,辛苦付之东流。

感谢这位大神的分享,还有通过数据透视和筛选的方法也可以做到这点,有兴趣的朋友可以看下原文。

支付宝打赏微信打赏

如果此文对你有帮助,欢迎打赏作者。

发表评论

欢迎回来 (打开)

(必填)

2417