如何用VBA+SQL在采购统计单中统计各个采购单数据

selen

已解决！非常感谢liangmutou01和任浪漫两位兄弟！！



1、在同一目录下有N个采购单文件，均以order开头的文件名命名，希望在采购单统计表工作簿中自动统计各采购单中的详细清单。
2、采购单如图：





3、统计表统计结果如图：






4、附件
采购单统计.rar (126.93 KB, 下载次数: 38)

2019-10-8 14:53 上传

点击文件名下载附件

5：说明：
     1）统计表中需要统计的数据均在24行以后
     2）采购单号、日期需要取出来。项目名称在送货地点中取 都放在统计表中
     3）有的采购单中没有品牌列
     4）采购单较多，希望用SQL处理数据

请哪位大侠帮忙看一下，能帮忙做一下更好，或者提供思路也行！

microyip

1、搜索所有文件
2、根据文件获取第一个表的标签名
3、根据标签名指定Select行数，加上条件是日期大于0

selen

microyip 发表于 2019-10-8 15:21
1、搜索所有文件
2、根据文件获取第一个表的标签名
3、根据标签名指定Select行数，加上条件是日期大于0

不太明白 能给个简单的实例吗？

microyip

selen 发表于 2019-10-8 16:43
不太明白 能给个简单的实例吗？

用你的需求分析，你就不想直接打开文件，想利用SQL获取里面的数据
那么你就从获取数据的每个步骤倒推需要些什么内容就知道我说的1、2、3是什么咯

selen

大概流程我知道 具体代码写起来有几个难点 我搞不定

wdx223

这种问题，用pq处理起来更便捷

liangmutou01

Sub tj()
  Application.ScreenUpdating = False
  Set conn = CreateObject("ADODB.Connection")
  Set jlj = CreateObject("ADODB.Recordset")
  conn.Open "provider=microsoft.ace.oledb.12.0;extended properties='excel 12.0;HDR=yes';data source=" & ThisWorkbook.FullName
  Range("a3:l65536").ClearContents
  lj = ThisWorkbook.Path & "\"
  wjm = Dir(lj & "*.xls")
  Do While wjm <> ""
    If wjm <> ThisWorkbook.Name Then
      jlj.Open "select * from [" & lj & wjm & "].[order$a10:g19]", conn, 1, 3
      djh = Mid(jlj.Fields(0).Value, 6)
      jlj.MoveLast
      mc = Mid(jlj.Fields(0).Value, 6)
      jlj.MoveFirst
      If IsNull(jlj.Fields(6).Value) Then
        rq = Mid(jlj.Fields(5).Value, 6)
        strsql = "select 序号,'" & djh & "','" & rq & "','" & mc & "',品名,'',规格要求,单位,数量,含税单价,金额,交货日期 from [" & lj & wjm & "].[order$a24:i65536] where not 交货日期 is null"
      Else
        rq = Mid(jlj.Fields(6).Value, 6)
        strsql = "select 序号,'" & djh & "','" & rq & "','" & mc & "',品名,品牌,规格要求,单位,数量,含税单价,金额,交货日期 from [" & lj & wjm & "].[order$a24:i65536] where not 交货日期 is null"
      End If
      Range("a" & [b65536].End(3).Row + 1).CopyFromRecordset _
       conn.Execute(strsql)
      jlj.Close
    End If
    wjm = Dir()
  Loop
  conn.Close
  Set jlj = Nothing
  Set conn = Nothing
  [a3] = 1
  [a3].AutoFill Range("a3:a" & [b65536].End(3).Row), xlFillSeries
  Application.ScreenUpdating = True
End Sub
Private Sub CommandButton1_Click()
  Call tj
End Sub

selen

liangmutou01 发表于 2019-10-8 22:10
Sub tj()
  Application.ScreenUpdating = False
  Set conn = CreateObject("ADODB.Connection")

你好 大侠  为什么在这个模板里可以使用 我放到我的实际采购单中总显示 外部表不是预期的格式？能不能加个威 信 请教一下 我的15501399666

selen

liangmutou01 发表于 2019-10-8 22:10
Sub tj()
  Application.ScreenUpdating = False
  Set conn = CreateObject("ADODB.Connection")

  运行到这儿的时候    jlj.Open "select * from [" & lj & wjm & "].[order$a10:g19]", conn, 1, 3  显示错误的 外部表不是预期格式

selen

liangmutou01 发表于 2019-10-8 22:10
Sub tj()
  Application.ScreenUpdating = False
  Set conn = CreateObject("ADODB.Connection")

采购单.zip (147.46 KB, 下载次数: 12)

2019-10-9 15:38 上传

点击文件名下载附件

大侠 帮我再看看！

已解决！感谢liangmutou01 大侠给出的解决方案： 采购单统计.zip (134.86 KB, 下载次数: 41)

2019-10-11 22:28 上传

点击文件名下载附件

代码如下：

1. 
   
2. Sub tj()
   
3.   Application.ScreenUpdating = False
   
4.   Set conn = CreateObject("ADODB.Connection")
   
5.   Set jlj = CreateObject("ADODB.Recordset")
   
6.   conn.Open "provider=microsoft.ace.oledb.12.0;extended properties='excel 12.0;HDR=yes';data source=" & ThisWorkbook.FullName
   
7.   Range("a3:l65536").ClearContents
   
8.   lj = ThisWorkbook.Path & ""
   
9.   wjm = Dir(lj & "*.xls")
   
10.   Do While wjm <> "" And wjm <> ThisWorkbook.Name
    
11.     jlj.Open "select * from [" & lj & wjm & "].[order$a10:i24]", conn, 1, 3
    
12.     djh = Mid(jlj.Fields(0).Value, 7)
    
13.     rq = Mid(jlj.Fields(6).Value, 7)
    
14.     jlj.Move (8)
    
15.     mc = Mid(jlj.Fields(0).Value, 6)
    
16.     jlj.MoveLast
    
17.     If IsNull(jlj.Fields(8).Value) Then
    
18.       strsql = "select 序号,'" & djh & "','" & rq & "','" & mc & "',品名,'',规格要求,单位,数量,含税单价,金额,交货日期 from [" & lj & wjm & "].[order$a24:i65536] where not 交货日期 is null"
    
19.     Else
    
20.       strsql = "select 序号,'" & djh & "','" & rq & "','" & mc & "',品名,品牌,规格要求,单位,数量,含税单价,金额,交货日期 from [" & lj & wjm & "].[order$a24:i65536] where not 交货日期 is null"
    
21.     End If
    
22.     Range("a" & [b65536].End(3).Row + 1).CopyFromRecordset _
    
23.       conn.Execute(strsql)
    
24.     jlj.Close
    
25.     wjm = Dir()
    
26.   Loop
    
27.   conn.Close
    
28.   Set jlj = Nothing
    
29.   Set conn = Nothing
    
30.   [a3] = 1
    
31.   [a3].AutoFill Range("a3:a" & [b65536].End(3).Row), xlFillSeries
    
32.   Application.ScreenUpdating = True
    
33. End Sub
    
34. 
    

复制代码