根据某列字段拆分多个工作簿

不信还重名

请问一下，运行就提示类型不匹配是什么原因

hheethheet

都是大神！！

mcd711

Sub 保留表头拆分数据为若干新工作簿()
     Dim arr, d As Object, k, t, i&, lc%, rng As Range, c%
     c = Application.InputBox("请输入拆分列号", , 4, , , , , 1)
     If c = 0 Then Exit Sub
     Application.ScreenUpdating = False
     Application.DisplayAlerts = False
     arr = [a1].CurrentRegion
     lc = UBound(arr, 2)
     Set rng = [a1].Resize(6, lc)                                  '本句代码中，偏移行的多少决定保留表头的行数，你要保留7行，就可以将6改为7即可。
    Set d = CreateObject("scripting.dictionary")
     For i = 2 To UBound(arr)                                     '这个起始数字，可以根据自己要从第几行开始拆分而定。
        If Not d.Exists(arr(i, c)) Then
             Set d(arr(i, c)) = Cells(i, 1).Resize(1, lc)
         Else
             Set d(arr(i, c)) = Union(d(arr(i, c)), Cells(i, 1).Resize(1, lc))
         End If
     Next
     k = d.Keys
     t = d.Items
     For i = 0 To d.Count - 1
         With Workbooks.Add(xlWBATWorksheet)
             rng.Copy .Sheets(1).[a1]
             t(i).Copy .Sheets(1).[a7]                         '这句中A列数字为几，则拆分后的数据在A列第几行，需要比前面红色注明的数字大1。
            .SaveAs Filename:=ThisWorkbook.Path & "\" & k(i) & ".xls"
             .Close
         End With
     Next
     Application.DisplayAlerts = True
     Application.ScreenUpdating = True
     MsgBox "完毕"
End Sub


请问这个代码怎样保持原来的格式，导出后，格式发生了变化

舒云天

感谢，又学习了

寒月满江

乐乐2006201505 发表于 2016-12-5 20:51
Sub 保留表头拆分数据为若干新工作簿()
    Dim arr, d As Object, k, t, i&, lc%, rng As Range, c%
    ...

大神知道怎么让这个代码能够保留原来表格的所有公式吗

bj917

版主的一行代码略作修改，   只需选中需要拆分的列即可，主要是有时有的表的列数多，数的话麻烦。
原代码：    'c = Application.InputBox("请输入拆分列号", , 4, , , , , 1)

替换为：    Set r = Application.InputBox("请选中需要拆分的列中任一单元格！确保该列没有!#@$%&字符", "拆分列的确定", , , , , , 8)
    r.Select
    c = ActiveCell.Column
   

bj917

不信还重名 发表于 2018-12-4 22:22
请问一下，运行就提示类型不匹配是什么原因

列中有其他字符#￥%……&，空，

szqhb

好代码必须收藏！

abigailluck

乐乐2006201505 发表于 2016-12-5 20:51
Sub 保留表头拆分数据为若干新工作簿()
    Dim arr, d As Object, k, t, i&, lc%, rng As Range, c%
    ...

感谢大神无私的分享~学习收藏了啊

cjq253

jiminyanyan 发表于 2016-6-19 20:59
上个附件吧。。。。。。

ADO查询后的数值被莫名+1，请问什么情况？
http://club.excelhome.net/thread-1534032-1-1.html
(出处: ExcelHome技术论坛)

大佬，求解惑，麻烦看看啊