对工作表按条件筛选，将筛选结果复制到新文档。

ykcbf1100

limonet 发表于 2023-9-6 08:26
能解决问题就行了

按题意，另存文件应该放在桌面上。

limonet

ykcbf1100 发表于 2023-9-6 08:47
按题意，另存文件应该放在桌面上。

附件说了放桌面

twl

limonet 发表于 2023-9-5 23:14
已经接近完成，但是你的2与3文件同名，拜托你用点心。

复制了第二条的信息没注意到文件名没改。

twl

limonet 发表于 2023-9-5 23:39
Sub Limonet()
    Dim StrSQL$, Cn As Object, IntoF$
    IntoF$ = "Into Sheet1 From  [Excel 12.0;Da ...

实在太强大了，顿时打开了新世界的大门。完成度99%，稍微修改一下就能使用。

1、日期上一个月问题：修改Format(Month(Date) + 1为 - 1能解决
2、放桌面而不是当前工作簿路径：将Data Source=" & ThisWorkbook.Path 修改为Data Source=" & "C:\" （以放在C盘根目录为例）能解决。


非常棒！！！

Sub Limonet2()
    Dim StrSQL$, Cn As Object, IntoF$
    IntoF$ = "Into Sheet1 From  [Excel 12.0;Database=" & ThisWorkbook.FullName & "].[产品表$C15:Y] Where"
    Set Cn = CreateObject("ADODB.connection")
    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 XML;Data Source=" & "C:\" & "\可食用产品-" & Year(Date) & Format(Month(Date) - 1, "00") & ".xlsx"
    StrSQL = "select 产品号,产品名称,产品编号1,产品编号2,产品编号3,产品编号4,产品编号5,产品编号6,是否可使用,使用范围1,使用范围2,使用范围3 " & IntoF$ & " 是否可使用='是'"
    Cn.Execute (StrSQL): Cn.Close
    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 XML;Data Source=" & "C:\" & "\小瓶产品-" & Year(Date) & Format(Month(Date) - 1, "00") & ".xlsx"
    StrSQL = "Select 产品号,产品名称,产品编号1,产品编号2,产品编号3,产品编号4,产品编号5,产品编号6,生产日期,到期日 " & IntoF$ & " [三] like '小瓶'+'%' and [七] Like '%'&'[A-C]'"
    Cn.Execute (StrSQL): Cn.Close
    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 XML;Data Source=" & "C:\" & "\小瓶浓度产品-" & Year(Date) & Format(Month(Date) - 1, "00") & ".xlsx"
    StrSQL = "Select 产品号,产品名称,产品编号1,产品编号2,产品编号3,产品编号4,产品编号5,产品编号6,生产日期,到期日 " & IntoF$ & " [三] like '小瓶'+'%' or [四] Like '浓度'&'%'"
    Cn.Execute (StrSQL): Cn.Close
End Sub

twl

ykcbf1100 发表于 2023-9-6 07:47
这个难是不难，就是写代码比较费时间。

附件供参考。。。

辛苦了，非常感谢大神的帮助。
经过测试，如果在原工作簿中执行的话可以实现到。

不过“要求1、2、3的结果”这三个工作表实际上是不在工作簿中的。代码应该是对这三个工作表做了引用，如果把这三个工作表删除了，运行时就会出错。

ykcbf1100

twl 发表于 2023-9-7 22:30
辛苦了，非常感谢大神的帮助。
经过测试，如果在原工作簿中执行的话可以实现到。

你这不是废话嘛，代码是根据附件写出来的，你现在把三个表删除了，不出错才怪。

twl

ykcbf1100 发表于 2023-9-8 07:43
你这不是废话嘛，代码是根据附件写出来的，你现在把三个表删除了，不出错才怪。

,主要是因为怕运行结果出错，所以把结果放在了原工作簿中作为一个参考，实际是不存在的。。

ykcbf1100

twl 发表于 2023-9-8 19:26
,主要是因为怕运行结果出错，所以把结果放在了原工作簿中作为一个参考，实际是不存在的。。

你可以用3楼的代码。

twl

ykcbf1100 发表于 2023-9-8 21:00
你可以用3楼的代码。

花了一晚时间把你的代码截开了三部分，再用call把它们连起来用。

xiaoyaolamb

limonet 发表于 2023-9-5 23:39
Sub Limonet()
    Dim StrSQL$, Cn As Object, IntoF$
    IntoF$ = "Into Sheet1 From  [Excel 12.0;Da ...

老师，您好。我按照你写的另外写了一份很长的输出字段，结果它创建不成功，报这个错误。能帮我看看下面是我写的StrSQL有什么错吗？
select 数据账期,地市编码,地市,区县编码,区县,片区编码,片区,服务中心编码,服务中心,客户经理工号,客户经理,集团代码,集团名称,集团等级,产品号码,专线号码,专线分类,资费名称,专线开户时间,带宽,资费金额,专线状态,是否离网,开户渠道编码,开户渠道名称,离网时间,开户工号,行业BU,八大行业,送费比例,送费金额,产品资费代码,融合专线号码,三新四融标识,渠道类型 Into Sheet1 From [Excel 12.0;Database=D:\Desktop\放在桌面.xlsm].[产品表$A39:AI] Where [专线开户时间] like '202403%' AND [区县] Like '高新%'

strSQLbug

D:\Pictures\Camera Roll\strSQLbug.png