多种方法计算原材料出库单价

         前几天，本人在ExcelHome论坛上看到一个贴子，发贴人本来是用函数计算原材料出库单价的，但数据量较大时，这种方法速度很慢，因此发贴求助，寻求速度快一些的方法。应该说，发贴人的计算方法并不科学，财务一般是不会用他这种方法记账的，企业通常采用的是“先入先出法”等方法。但作为Excel应用探讨，本人从中也学到了一些知识，现将三种实现方法整理如下。（部分代码已修改）

        发贴人的计算公式是：出库单价＝出库日之前该材料的所有入库金额/出库日之前该材料的所有入库数量，提供“入库”表和“出库”表两个工作表。

“入库”表数据如下：

“出库”表数据如下：

要求：计算出每次出库材料的单价。

1、公式法

先定义4个“名称”。

入库日期：=OFFSET(入库!$G$2,,,COUNTA(入库!$G:$G))

入库名称：=OFFSET(入库!$H$2,,,COUNTA(入库!$H:$H))

入库数量：=OFFSET(入库!$J$2,,,COUNTA(入库!$J:$J))

入库金额：=OFFSET(入库!$L$2,,,COUNTA(入库!$L:$L))

在L2单元格中输入公式：=SUMPRODUCT((入库名称=H2)*(入库日期<=G2),入库金额)/SUMPRODUCT((入库名称=H2)*(入库日期<=G2),入库数量)，向下拖动公式。

缺点：如果数据有几千行,公式运行起来速度会很慢。

2、用VBA代码

Sub VBA_Price()
    Application.ScreenUpdating = False
    Dim rkArray, ckArray, Cost, Qty
    '入库数组、出库数组，金额、数量变量
    
    'rkArray = Sheet1.Range("G2:L" & Sheet1.Cells(Rows.Count, "G").End(3).Row).Value
    'ckArray = Sheet2.Range("G2:K" & Sheet2.Cells(Rows.Count, "G").End(3).Row).Value   '或
    rkArray = Sheets("入库").Range("G2:L" & Sheets("入库").Range("G65536").End(xlUp).Row)
    ckArray = Sheets("出库").Range("G2:K" & Sheets("出库").Range("G65536").End(xlUp).Row)
    
    For ic = 1 To UBound(ckArray)
        Cost = 0: Qty = 0
        For ir = 1 To UBound(rkArray)
            If rkArray(ir, 1) <= ckArray(ic, 1) And rkArray(ir, 2) = ckArray(ic, 2) Then
                Cost = Cost + rkArray(ir, 6)
                Qty = Qty + rkArray(ir, 4)
            ElseIf rkArray(ir, 1) > ckArray(ic, 1) Then
                Exit For
            End If
        Next
        ckArray(ic, 5) = Cost / Qty
    Next
    'Sheets("出库").Range("G2:K" & Sheets("出库").Range("G65536").End(xlUp).Row) = ckArray    '或
    Sheets("出库").[K2].Resize(UBound(ckArray)) = Application.Index(ckArray, 0, 5)
    Application.ScreenUpdating = True
End Sub

3、用SQL

Sub SQL_Price()
    Dim Cnn As Object, SQL As String, r1 As Long, r2 As Long, Start As Single
    Start = Timer
    Application.ScreenUpdating = False
    r1 = Sheets("入库").[G65536].End(xlUp).Row
    r2 = Sheets("出库").[G65536].End(xlUp).Row
    Set Cnn = CreateObject("ADODB.Connection")
    Cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & ThisWorkbook.FullName
    SQL = "select d.单价 from [出库$G1:J" & r2 & "] c,(select b.日期,b.名称规格,sum(a.金额)/sum(a.实发数量) as 单价,b.实发数量 from [入库$G1:L" & r1 & "] a ,[出库$G1:J" & r2 & "] b where a.日期<=b.日期 and a.名称规格=b.名称规格 group by b.日期,b.名称规格,b.实发数量) d where c.日期=d.日期 and c.名称规格=d.名称规格 and c.实发数量=b.实发数量"
    [M2].CopyFromRecordset Cnn.Execute(SQL)
    Cnn.Close
    Set Cnn = Nothing
    Application.ScreenUpdating = True
    MsgBox "耗时" & (Timer - Start) & "秒"
End Sub