条件动态查找粘贴汇总

sdgyc

条件动态查找粘贴.zip (27.18 KB, 下载次数: 7)

2017-7-23 13:30 上传

点击文件名下载附件
附件

请求老师帮助：根据填写日期条件查找不重复粘贴各店订单表商品编号、商品名称、计量单位本表A-C列，将各店订单表的店名称不重复转置粘贴到G3并将各店的数量分别汇总到对应列中。效果如本表
多谢！！！！！！

凌空一羽

Sub lkyy()
Set cnn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
cnn.Open "provider=microsoft.ace.oledb.12.0;extended properties='excel 12.0;hdr=yes;imex=1';data source=" & ThisWorkbook.FullName
Sql = "transform  sum(数量)  select 商品编号,商品名称,计量单位 from [各店订单$] where 日期 = #" & [b2] & "# group by 商品编号,商品名称,计量单位 pivot 店名称"
Set rst = cnn.Execute(Sql)
arr = cnn.Execute(Sql).GetRows()
r = UBound(arr, 2)
c = UBound(arr)
ReDim ar(0 To r, 1 To 3)
ReDim br(0 To r, 4 To c + 1)
For i = 0 To r
    For j = 0 To c
    If j + 1 < 4 Then
        ar(i, j + 1) = arr(j, i)
    Else
        br(i, j + 1) = arr(j, i)
    End If
    Next
Next
For i = 3 To rst.Fields.Count - 1
    Cells(3, i + 4) = rst.Fields(i).Name
Next
Range("a4").Resize(r + 1, 3) = ar
Range("g4").Resize(r + 1, c - 2) = br
cnn.Close
Set cnn = Nothing
End Sub