ExcelVBA用字典方法做先进先出法.pdf

ExcelVBA⽤字典⽅法做先进先出法 多年前，⼀家外包公司帮我司⼀物业公司做仓库收发存管理软 ，我⽅要求先进先出法，该外包公司称那需要加⼊批次管理，每次出库选择 好批次才能实现先进先出。我以为，这完全是谬论，既然是先进先出，那就已经设定好了规律和逻辑，不需要再指定批次，否则那还叫什么 先进先出。最近，闲来⽆事，⽤EXCEL编了个⼩程序，经调试，是可以做到先进先出的。上图： 备注 ：出⼊库按⼊正出负的原则制订 完整代码 ： Public Crr() As Integer, StartingPosition% Sub First InFirstOut() Dim Arr, Brr, Drr, i%, ypeCount%, j%, MaxAmount% Dim Dic As Object Set Dic = CreateObject(scripting.dictionary) Arr = [A1].CurrentRegion 按字典⽅法，获取产品种类 For i = 2 o UBound(Arr) If Arr(i, 2) = 0 hen Dic(Arr(i, 1)) = Dic(Arr(i, 1)) + Arr(i, 2) End If Next ypeCount = Dic.Count Brr = Dic.Keys Drr = Dic.Items 获取进货的总数量 MaxAmount = Application.WorksheetFunction.Max(Drr) ReDim Crr(1 o ypeCount, 1 o MaxAmount) For i = 2 o UBound(Arr) If Arr(i, 2) 0 hen For j = 0 o ypeCount - 1 If Brr(j) = Arr(i, 1) hen If Arr(i, 2) 0 hen If Arr(i, 2) 0 hen ⽬标Crr，第⼀维度为j+1,第⼆维度的数量 ：cells （i,2) ，第⼆维度的单价 ：cells(i,3) Call GetStartingPosition(j + 1) Call AddDate(j + 1, Val(Arr(i, 2)), Val(Arr(i, 3))) Exit For Else Call DeleteDate(j + 1, Val(Arr(i, 2)), i) Exit For End If End If Next End If Next End Sub Sub GetStartingPosition(i As Integer) For k = 1 o UBound(Crr, 2) If Crr(i, k) = Empty Or Crr(i, k) = 0 hen StartingPosition = k Exit For End If Next End Sub Sub AddDate(i%, j%, k%) For x = StartingPosition