我是PowerPivot / DAX的新手，我在尝试解决的特定问题上遇到了一些麻烦。我有多个商店的系列产品，需要从尽可能少的商店发货一定数量。
表格Products包含产品清单和所需金额：
Product | Need
0000001 | 7
0000002 | 8
另一个表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
首先，我按照可用的单位对每个产品中的商店进行排名，随机解决关系：
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表有大约20万条产品的约2M记录，运行时会有任何问题吗？
答案 0 :(得分：0)
我想到了另一个解决方案 - 使用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
首先，我想告诉Transportation Problem这个任务非常熟悉。所以我想到了可能找到最低运输成本的数学公式。
此解决方案直接贯穿所有组合。它使用二进制数来决定选择哪个商店。例如，01101表示尝试存储2,3和5.这会给计算机带来很多麻烦，以计算每种可能性。所以我的商店数量有限到16个。
此外，我在1000个产品上尝试了此代码，而不是20k。我的电脑无法用20k的产品解决这个问题。所以有人可以让我的代码更快地运行。 =＆GT;
第三张表是每家商店的运输成本。我把它添加到模型中：
| Store | Cost |
| 00001 | 5 |
| 00002 | 2 |
| 00003 | 1 |
| 00004 | 1 |
| 00005 | 10 |
因此，任务是找到最低的运输成本。 =＆GT;
我在代码中使用了公式SUMIFS。它在Excel 2003中不起作用。 =＆GT;
我相信这可以为您提供一些想法，并帮助其他人制定准则。