- 帖子
- 1018
- 主題
- 15
- 精華
- 0
- 積分
- 1058
- 點名
- 0
- 作業系統
- win7 32bit
- 軟體版本
- Office 2016 64-bit
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 桃園
- 註冊時間
- 2012-5-9
- 最後登錄
- 2022-9-28
|
2#
發表於 2016-3-18 14:25
| 只看該作者
回復 1# qmi - Sub Test()
- Dim arInput, flagTake
- Dim dResult As Object: Set dResult = CreateObject("scripting.dictionary")
-
- arInput = Range("A1").CurrentRegion.Value
- ReDim flagTake(LBound(arInput, 2) To UBound(arInput, 2)) As Boolean 'true=取 ; false=不取
-
- backtrack arInput, flagTake, 1, 0, dResult
-
- Range("E:F").ClearContents
- Range("E4").Resize(dResult.count).Value = Application.Transpose(dResult.keys)
- Range("F4").Resize(dResult.count).Value = Application.Transpose(dResult.items)
- End Sub
- Sub backtrack(ByRef arInput, ByRef flagTake, n As Integer, cost As Double, ByRef dResult As Object)
- Dim i As Integer, strOut As String
-
- If cost > 0 And cost <= 105 Then
- For i = LBound(arInput, 2) To UBound(arInput, 2)
- If Len(strOut) = 0 Then
- strOut = IIf(flagTake(i), arInput(1, i), "")
- Else
- strOut = strOut & IIf(flagTake(i), "+" & arInput(1, i), "")
- End If
- Next
- dResult.Add strOut, cost 'push to result
- End If
-
- For i = n To UBound(arInput, 2)
- flagTake(i) = True
- backtrack arInput, flagTake, i + 1, cost + arInput(2, i), dResult
- flagTake(i) = False '回復flag
- Next
- End Sub
複製代碼 |
|