根据每月每天进出库数据，做每月汇总分析表

wenfo88888

根据每月每天进出库数据，做每月汇总分析表

约定的童话

SMT仓库管理员啊？

zhouxiao

是SMT的物料

wenfo88888

朱荣兴 发表于 2019-9-16 11:30
一个字典匹配问题，先完善你的表格，汇总工作表中列出所有的月份，

请赐教，能用VBA完成？

xiangbaoan

………………

wenfo88888

xiangbaoan 发表于 2019-9-16 14:07
………………

谢谢，辛苦了

xiangbaoan

wenfo88888 发表于 2019-9-16 14:36
谢谢，辛苦了

为人民服务~~~

wenfo88888

xiangbaoan 发表于 2019-9-16 14:44
为人民服务~~~

要是能在代码旁加以说明，更完美，谢谢

xiangbaoan

wenfo88888 发表于 2019-9-17 11:22
要是能在代码旁加以说明，更完美，谢谢

'说明?我看算了，三言两语说不清，那样我会把手敲麻的。
'我给你一段改进了一点的，你可按指定的月份及顺序汇总，没有的月份空着。
Sub test()
Dim A, ar(), tp, Cn As Object, Rs As Object, Sq$, i%, j%, k%, r&, c%
Sheets("想要的结果").Activate
Cells.ClearContents
Set Cn = CreateObject("ADODB.Connection")
Set Rs = CreateObject("ADODB.Recordset")
Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName '2007及以上版本用此句
'Cn.Open "Provider=Microsoft.JET.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & ThisWorkbook.FullName '2003版本用此句
A = Split("SUM(入库数量) SUM(出库数量)")
r = Sheets("出入库流水数量").Cells(Rows.Count, 1).End(xlUp).Row
For k = 0 To UBound(A)
    Sq = "TRANSFORM " & A(k) & " SELECT NULL AS [NO],存货编码,存货名称,规格型号 FROM [出入库流水数量$A1:F" & r & "] GROUP BY 存货编码,存货名称,规格型号 PIVOT MONTH(日期) IN(1,2,3,4,5)"
    Rs.Open Sq, Cn, 1, 3
    tp = Rs.GetRows
    If k = 0 Then
        ReDim ar(UBound(tp, 2), UBound(tp) * 2)
        c = 5
        For i = 0 To Rs.Fields.Count - 1
            If i > 3 Then
                Cells(1, c) = Rs.Fields(i).Name
                Cells(2, c).Resize(, 2) = Split("总入 总出")
                c = c + 2
            Else
                Cells(1, i + 1) = Rs.Fields(i).Name
            End If
        Next
    End If
    For j = 1 To UBound(tp)
        If j > 3 Then
            c = j * 2 - 4 + k
            For i = 0 To UBound(tp, 2)
                ar(i, c) = tp(j, i)
             Next
        Else
            If k = 0 Then
                For i = 0 To UBound(tp, 2)
                    If j = 1 Then ar(i, 0) = i + 1
                    ar(i, j) = tp(j, i)
                Next
            End If
        End If
    Next
    If Rs.State = 1 Then Rs.Close
Next
[a3].Resize(i, UBound(ar, 2)) = ar
Cn.Close
Set Cn = Nothing
Set Rs = Nothing
End Sub