http://www.pptjcw.com

excel宏教程:用VBA按列信息拆分数据到多张工作表

    在本问题中,要将拆分结果保存在新工作簿中,那可以在执行拆分数据的操作前,先新建工作簿及工作表来保存拆分结果。

    在写过程前,可以在模块的开始位置先声明两个模块级变量或公共变量:表示保存拆分结果的工作簿ToWb和要拆分的数据表Sht,如:

    Dim ToWb As Workbook, Sht As Worksheet

    然后将新建保存结果的工作簿及工作表的代码写为单独的过程,如:

    Sub ShtAdd()
    Dim ShtCount As Integer '记录新建工作簿中包含的工作表数量
    Set ToWb = Workbooks.Add '新建工作簿,并存到变量ToWb中
    ShtCount = ToWb.Worksheets.Count
    Dim i As Long, ShtName As String
    i = 2
    'Do循环语句用于在工作簿中新建保存拆分结果的工作表
    Do While Sht.Cells(i, "A").Value ""
    ShtName = Sht.Cells(i, "A").Value
    If IsSht(ShtName) = False Then 'IF语句判断指定名称的工作表是否存在
    ToWb.Worksheets.Add after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = ShtName
    Sht.Rows(1).Copy ToWb.Worksheets(ShtName).Rows(1) '复制表头到新工作表中
    End If
    i = i + 1
    Loop
    'For循环语句删除新建的工作簿中原带的空工作表
    Application.DisplayAlerts = False
    For i = ShtCount To 1 Step -1
    ToWb.Worksheets(i).Delete
    Next i
    Application.DisplayAlerts = True
    End Sub

    其中用到一个判断指定名称的工作表是否存在的自定义函数,代码为:

    Function IsSht(ByVal ShtName As String) As Boolean '判断工作表名称是否存在
    On Error Resume Next
    If Worksheets(ShtName) Is Nothing Then
    IsSht = False '工作表不存在,函数值为False
    Else
    IsSht = True '工作表已存在,函数值为true
    End If
    End Function

    当然,这个判断工作表是否存在的代码,也可以直接写在过程中。

    最后,再在原有程中,在执行拆分数据的操作前先调用上面的子过程ShtAdd,就能解决这个问题了,如:

    Sub 拆分数据到工作表()
    Dim ShtName As String, ToRng As Range, i As Integer, DataArr As Variant
    Set Sht = ActiveSheet
    Call ShtAdd ' 调用子过程,新建保存拆分结果的工作表及工作表
    i = 2 '要拆分的第一条数据的行号
    Do While Sht.Cells(i, "A").Value ""
    ShtName = Sht.Cells(i, "A").Value
    Set ToRng = ToWb.Worksheets(ShtName).Range("A1048576").End(xlUp).Offset(1, 0)
    DataArr = Sht.Cells(i, "A").Resize(1, 8).Value
    ToRng.Resize(1, 8).Value = DataArr '用数组传递数据
    i = i + 1 '重设变量的值,以便下次循环能拆分新的记录
    Loop
    End Sub

    代码容器中完成后的代码截图如下:

    excel宏教程:用VBA按列信息拆分数据到多张工作表

    执行“拆分数据到工作表”的过程,就能工作表中的数据,按A列的信息拆分到不同工作表,保存在新工作簿中了。

    提示:如果您觉得本文不错,请点击分享给您的好友!谢谢

    上一篇:excel怎么做表格:正确填写票据和结算凭证的基本规定 下一篇:xcel表格制作教程入门:在最后一张工作表后插入一张新工作表

    郑重声明:本文版权归原作者所有,转载文章仅为传播更多信息之目的,如作者信息标记有误,请第一时间联系我们修改或删除,多谢。