自动拆分表格问题

witkeyli

zhaogang1960 发表于 2014-4-21 16:51
是的：

附上代码：
Sub Macro1()
    Dim cnn As Object, rs As Object, SQL$, sFile$, i&
    Set cnn = CreateObject("adodb.connection")
    Set rs = CreateObject("adodb.Recordset")
    cnn.Open "Provider=Microsoft.ace.Oledb.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & ThisWorkbook.FullName
    SQL = "select distinct 销售服务店  from [" & ActiveSheet.Name & "$] where销售服务店is not null"
    rs.Open SQL, cnn, 1, 3
    For i = 1 To rs.RecordCount
        sFile = ThisWorkbook.Path & "\" & rs.Fields(0).Value & ".xlsx"
        If Dir(sFile) <> "" Then Kill sFile
        SQL = "select * into [" & sFile & "].[Sheet1] from [" & ActiveSheet.Name & "$] where销售服务店='" & rs.Fields(0).Value & "'"
        cnn.Execute SQL
        rs.MoveNext
        Next
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
    MsgBox "拆分完成！", vbInformation
End Sub

witkeyli

zhaogang1960 发表于 2014-4-21 16:51
是的：

另外，您看这一句有什么问题啊，问什么运行到这里的时候也提示FROM子句语法错误啊， SQL = " select * into [" & sFile & "].[Sheet1]  from [" & ActiveSheet.Name & "$]  where 销售服务店= '" & rs.Fields(0).Value & " '"

zhaogang1960

witkeyli 发表于 2014-4-22 13:49
另外，您看这一句有什么问题啊，问什么运行到这里的时候也提示FROM子句语法错误啊， SQL = " select * in ...

好像有多余的空格,请与下面一句对比一下:
Sql = "select * into [" & sFile & "].[Sheet1] from [" & ActiveSheet.Name & "$] where 销售服务店='" & rs.Fields(0).Value & "'"

df_nine

zhaogang1960 发表于 2012-7-7 23:49
把英文符号换成中文符号就可以了：

赵老师，下载了您写好的代码，遇到一个问题，希望您帮忙改一下。
拆分过的exl表，第一列序号能不能自动生成1、2、3、4、5。。。。，

df_nine

见附件。麻烦改一下

df_nine

zhaogang1960 发表于 2014-4-22 14:17
好像有多余的空格,请与下面一句对比一下:
Sql = "select * into [" & sFile & "].[Sheet1] from [" & Ac ...

赵老师，麻烦您抽时间指导一下，

df_nine

zhaogang1960 发表于 2014-4-22 14:17
好像有多余的空格,请与下面一句对比一下:
Sql = "select * into [" & sFile & "].[Sheet1] from [" & Ac ...

赵老师，麻烦您抽时间指导一下，

builtgor1

为什么用在excel2003版本不行的？

大头菜871118

不错啊，谢谢

Doc_snows

上面的拆分没有问题了，现有一新需求原表中除了需要拆分的表外还有另外两张表如表A和表B，如何把每个拆分生产的新表中都保留表A和表B这两个Sheet，这两表中内容跟原表中一样