根据等级上限累计总和
我是PowerPivot / DAX的新手，我正在尝试解决某个特定问题。 我有多个商店的一系列产品，需要从尽可能less的商店出货一定的数量。
一张表Products包含产品清单和所需金额：
Product | Need 0000001 | 7 0000002 | 8
另一个表Stores包含Stores可用的单位，我需要计算每个商店发送的数量：
Product | Store | Units | Send 0000001 | 00001 | 5 | 5 0000001 | 00002 | 2 | 2 0000001 | 00003 | 1 | 0 0000002 | 00001 | 0 | 0 0000002 | 00002 | 3 | 1 0000002 | 00003 | 3 | 3 0000002 | 00004 | 4 | 4 0000002 | 00005 | 2 | 0
我想为计算添加一些列：
Product | Store | Units | Rank | CSum | Send 0000001 | 00001 | 5 | 1 | 5 | 5 0000001 | 00002 | 2 | 2 | 7 | 2 0000001 | 00003 | 1 | 3 | 8 | 0 0000002 | 00001 | 0 | 5 | 12 | 0 0000002 | 00002 | 3 | 3 | 10 | 1 0000002 | 00003 | 3 | 2 | 7 | 3 0000002 | 00004 | 4 | 1 | 4 | 4 0000002 | 00005 | 2 | 4 | 12 | 0
首先，我用可用的单位对每个产品中的商店进行sorting，随机地解决关系：
Rank := IF(Units>0,RANKX(ALL(Stores,Stores[Product]),Stores[Units]+RAND())
然后，我计算累计和：
CSum := CALCULATE(SUM(Stores[Units]), FILTER(ALL(Stores,Stores[Product]),Stores[Rank]<=MAX(Stores[Rank])))
最后，我计算发送量：
Send := IF(Stores[CSum]>RELATED(Products[Need])+Stores[Units], IF(Stores[CSum]<RELATED(Products[Need]), Stores[Units],Stores[Units]-(Stores[CSum]-RELATED(Products[Need]))),0)
不用说，我越来越#ERROR 。 我认为思想过程是有效的，但是公式是错误的。 此外，我的Stores表有〜约2万个产品〜2Mlogging，我会有任何问题，运行此？
我想到了另一个解决scheme – 使用VBA代码。 首先，我想给整个代码，然后描述一些问题：
Const maxStores = 16 Public i As Long Public j As Integer Public n As Integer Public m As Long Public rangeNeeds As Range Public rangeHave As Range Public rangeCost As Range Sub transportation() Dim Time1, Time2 Dim Txt As String Txt = "Enter range with " Set rangeNeeds = Application.InputBox(prompt:=Txt & "Needs", Type:=8) Set rangeHave = Application.InputBox(prompt:=Txt & "Inventory", Type:=8) Set rangeCost = Application.InputBox(prompt:=Txt & "Costs", Type:=8) ' find number of Stores n = rangeCost.Rows.Count If n <= maxStores Then ' Algorithm #1 ' ' ' Step 1 ' ------------------------------------------------------------------------ ' make array of binary numbers & sort it Time1 = Timer ' make array of indexes Dim ArrIndex() As Long ReDim ArrIndex(1 To n) For j = 1 To n ArrIndex(j) = rangeCost(j, 2) Next j ' make Indexes minCost = Application.WorksheetFunction.min(ArrIndex) For j = 1 To n If minCost = 0 Then Debug.Print "Can't count Cost = 0" Exit Sub End If ArrIndex(j) = ArrIndex(j) / minCost Next j ' make array with indexes ' each index represents ' cost of transportanion Dim Index As Long Dim ll As Integer Dim k, Temp k = 2 ^ n - 1 ll = Len(k) + 1 Dim Arr() ReDim Arr(1 To k) For i = 1 To k ' count total index For j = 1 To n Index = Index + CInt(Mid(Dec2Bin(i, n), j, 1)) * ArrIndex(j) Next j Temp = Index * 10 ^ ll + i Arr(i) = Temp Index = 0 Next i ' sort Array Call Countingsort(Arr) ' end of Step1 ' ======================================================================== ' ' ' Step2 ' ------------------------------------------------------------------------ ' Go throug each value and find the answer Dim ProdNo As Long ' number of products in order ProdNo = rangeNeeds.Rows.Count Dim ArrHave() As Long ReDim ArrHave(1 To ProdNo) Dim rangeHaveProd As Range Dim rangeHaveStor As Range Dim rangeHaveQuan As Range Set rangeHaveProd = rangeHave.Columns(1) Set rangeHaveStor = rangeHave.Columns(2) Set rangeHaveQuan = rangeHave.Columns(3) For i = 1 To k ' All Binary Numbers Temp = CInt(Right(Arr(i), ll - 1)) Temp = Dec2Bin(Temp, n) ' try fulfill the order For j = 1 To n ' All Stores, n -- index of Store Index = 0 Index = CInt(Mid(Temp, j, 1)) If Index = 1 Then 'If Store is On For m = 1 To ProdNo ' All Products, m -- index of Product ArrHave(m) = ArrHave(m) + _ WorksheetFunction.SumIfs( _ rangeHaveQuan, _ rangeHaveProd, rangeNeeds(m, 1), _ rangeHaveStor, rangeCost(j, 1)) Next m End If Next j ' Check if Needs meets Dim CheckNeeds As Boolean For m = 1 To ProdNo If ArrHave(m) < rangeNeeds(m, 2) Then CheckNeeds = False Exit For Else CheckNeeds = True End If Next m If CheckNeeds Then Debug.Print "Answer is " & Temp Exit For Else ReDim ArrHave(1 To ProdNo) End If Next i ' end of Step2 ' ======================================================================== ' ' ' Step3 ' ------------------------------------------------------------------------ ' make report Sheets.Add Dim Ws As Worksheet Set Ws = ActiveSheet With Range("A1") .Value = "Report" .Font.Size = 22 .Font.Bold = True End With Rows("4:4").Font.Bold = True With Ws ' Stores table .Range("G4") = "Store" .Range("H4") = "Cost" .Range("I4") = "On" rangeCost.Copy .Range("G5").PasteSpecial xlPasteValues For i = 1 To n .Range("I" & 4 + i) = Mid(Temp, i, 1) Next i ' Needs table .Range("K4") = "Product" .Range("L4") = "Need" rangeNeeds.Copy .Range("K5").PasteSpecial xlPasteValues ' Have table .Range("A4") = "Product" .Range("B4") = "Store" .Range("C4") = "Units" .Range("D4") = "On" .Range("E4") = "Send" rangeHave.Copy .Range("A5").PasteSpecial xlPasteValues .Range("D5:D" & 4 + rangeHave.Rows.Count).FormulaR1C1 = _ "=VLOOKUP(RC[-2],C[3]:C[5],3,0)" Dim QForm As String QForm = "=IF(RC[-1]=0,0,IF(SUMIFS(C[7],C[6]," QForm = QForm & "RC[-4])-SUMIFS(R4C5:R[-1]C,R4C1:R[-1]C[-4]," QForm = QForm & "RC[-4])-RC[-2]>0,RC[-2],IF(SUMIFS(C[7],C[6],RC[-4])" QForm = QForm & "-SUMIFS(R4C5:R[-1]C,R4C1:R[-1]C[-4],RC[-4])-RC[-2]<0," QForm = QForm & "SUMIFS(C[7],C[6],RC[-4])-SUMIFS(R4C5:R[-1]C," QForm = QForm & "R4C1:R[-1]C[-4],RC[-4]),RC[-2])))" .Range("E5:E" & 4 + rangeHave.Rows.Count).FormulaR1C1 = QForm Range("A2").FormulaR1C1 = "=""Total Cost = ""&INT(SUMIFS(C[7],C[8],1))" Range("A2").Font.Italic = True .Calculate ' convert formulas into values .Range("D5:E" & 4 + rangeHave.Rows.Count) = .Range("D5:E" & 4 + rangeHave.Rows.Count).Value End With ' end of Step3 ' ======================================================================== ' Time2 = Timer Debug.Print Format(Time2 - Time1, "00.00") & " sec." Else MsgBox "Number of stores exceeds Maximum. Need another Algorithm" End If End Sub 'Decimal To Binary ' ================= ' Source: http://groups.google.ca/group/comp.lang.visual.basic/browse_thread/thread/28affecddaca98b4/979c5e918fad7e63 ' Author: Randy Birch (MVP Visual Basic) ' NOTE: You can limit the size of the returned ' answer by specifying the number of bits Function Dec2Bin(ByVal DecimalIn As Variant, _ Optional NumberOfBits As Variant) As String Dec2Bin = "" DecimalIn = Int(CDec(DecimalIn)) Do While DecimalIn <> 0 Dec2Bin = Format$(DecimalIn - 2 * Int(DecimalIn / 2)) & Dec2Bin DecimalIn = Int(DecimalIn / 2) Loop If Not IsMissing(NumberOfBits) Then If Len(Dec2Bin) > NumberOfBits Then Dec2Bin = "Error - Number exceeds specified bit size" Else Dec2Bin = Right$(String$(NumberOfBits, _ "0") & Dec2Bin, NumberOfBits) End If End If End Function Sub Countingsort(list) Dim counts() Dim i Dim j Dim next_index Dim min, max Dim min_value As Variant, max_value As Variant ' Allocate the counts array. VBA automatically ' initialises all entries to 0. min_value = Minimum(list) max_value = Maximum(list) min = LBound(list) max = UBound(list) ReDim counts(min_value To max_value) ' Count the values. For i = min To max counts(list(i)) = counts(list(i)) + 1 Next i ' Write the items back into the list array. next_index = min For i = min_value To max_value For j = 1 To counts(i) list(next_index) = i next_index = next_index + 1 Next j Next i End Sub Function Minimum(list) Dim i As Long Minimum = list(LBound(list)) For i = LBound(list) To UBound(list) If list(i) < Minimum Then Minimum = list(i) Next i End Function Function Maximum(list) Dim i As Long Maximum = list(LBound(list)) For i = LBound(list) To UBound(list) If list(i) > Maximum Then Maximum = list(i) Next i End Function
首先要说的是交通问题对交通问题非常熟悉。 所以我想到可能的math公式，可以find最低的运输成本。
问题＃1。 大数据
这个解决scheme直接通过所有的组合。 它使用二进制数来决定select哪个商店。 例如，01101表示尝试存储2,3和5.这给计算机计算每个可能性造成了很大的麻烦。 所以我把店面数量限制到了16个。
我也试过1000个产品的代码，而不是20k。 我的电脑不能用20k的产品来解决这个问题。 所以有人可以使我的代码工作更快。 =>
问题＃2。 成本
第三个表是每个商店的运输成本。 我把它添加到模型：
| Store | Cost | | 00001 | 5 | | 00002 | 2 | | 00003 | 1 | | 00004 | 1 | | 00005 | 10 |
所以任务是find最小的运输成本。 =>
Excel版本
我在我的代码中使用了公式SUMIFS。 它不会在Excel 2003中工作。=>
结论
我相信这给你一些想法，并帮助别人来制定“守则”。