晚上好，我在這里潛伏了很長時間，但我遇到了一個我似乎無法找到解決方案的問題。我不知道我是否正確發布了這個，因為我沒有任何基本代碼可以提供，因為我不確定在 VBA 中是否有可能。
我有一個串列，其值的大小可變，單個值的范圍從 1 到 33。（這是基于卡車中的托盤數量）我想做的是選擇該范圍并進行 vba 代碼排序找出將我的值總結為 33 的最佳方法（但永遠不會超過 33！）并使用這些值創建一個陣列并繼續下一個“集合”并將下一個添加到 33 的值放入一個新陣列中。我知道如何長期這樣做（感謝stackoverflow上的另一個用戶），但這意味著它不是最有效的選擇。
假設我有一個包含 5 個不同值的串列：
10 15 8 22 19
這將創建以下“集合”：
25 30 19
但如果 5 個值的順序將更改為：
19 22 15 10 8
它將創建以下集合：
19 22 15 18
現在我找到了一種方法來定義代碼應該創建的最佳卡車數量的變數，但是對于第二個串列，如果我現在擁有的代碼長期通過該串列，則會導致錯誤。
總而言之，是否有可能創建一個代碼來查看一系列值并決定將最接近 33 的值組合起來的最有效方法是什么。
生病提供我現在擁有的代碼，請注意它還沒有完成并且非常基本，因為它只是我專案的開始，并且幾乎是我想要實作的核心功能。如果我需要提供更多資訊或詳細資訊，請告訴我
提前致謝。非常感謝這里的一大群人，他們自己不知道，通過為我遇到但不需要問的問題提供解決方案，幫助我節省了數小時的作業時間
這是我的代碼：
Sub test()
Dim ref, b As Range
Dim volume, i As Integer
Dim test1(), check, total As Double
Dim c As Long
Set ref = Selection
volume = ref.Cells.Count
c = ref.Column
ReDim test1(1 To volume)
'this creates a total of all the values i select
For Each b In ref
total = total b
Next b
'this determines when to round up or down
check = total / 33 - Application.WorksheetFunction.RoundDown(total / 33, 0)
If check < 0.6 Then
total = Application.WorksheetFunction.RoundDown(total / 33, 0)
Else
total = Application.WorksheetFunction.RoundUp(total / 33, 0)
End If
'this creates an array with all the values
i = 1
Do Until i = volume 1
test1(i) = Cells(i, c).Value
i = i 1
Loop
'this is just a way for me to check and verify my current part of the code
MsgBox (Round(test1(8), 2))
MsgBox (total)
End Sub
uj5u.com熱心網友回復：
您可以根據需要更改單元格結果位置。我在即時視窗中顯示結果。
Sub test()
Dim CellsCount As Integer
CellsCount = Selection.Cells.Count
Dim i, j As Long
Dim x, y As Long
Dim SumLoop As Long
SumLoop = 0
x = 1
y = 1
For i = x To CellsCount
Do
For j = y To CellsCount
SumLoop = SumLoop Selection.Cells(j).Value
If SumLoop < 33 Then
Debug.Print SumLoop
y = j 1
If y = CellsCount 1 Then Exit Sub
Else
SumLoop = 0
x = j
y = j
Exit For
End If
Next
Loop While SumLoop < 33
Next
End Sub
uj5u.com熱心網友回復：
這是一種直接的蠻力，檢查每一個組合，如果你的集合太大，這會減慢速度，但在 1,000 的集合中小于 1 秒。
我將值加載到 A 列中。輸出您需要的最低數量的卡車。
您可能可以通過使用型別或類來減少變數的數量，但希望保持相對簡單。
Dim i As Long
Dim lr As Long
Dim limit As Long
Dim count As Long
Dim sets As Long
Dim best As Long
Dim start As Long
Dim addset As Boolean
Dim loopcounter As Long
limit = 33
With Sheets("Sheet1")
lr = .Cells(.Rows.count, 1).End(xlUp).Row
Dim arr() As Long
ReDim arr(0 To lr - 2)
For i = 2 To lr
arr(i - 2) = .Cells(i, 1).Value 'Load array
Next i
start = 0
i = start
Do
If count arr(i) <= limit Then
count = count arr(i)
addset = False 'Just for tracking the final set
Else
addset = True
sets = sets 1
count = arr(i)
End If
i = i 1
If i > UBound(arr) Then
i = 0 'reset index
End If
loopcounter = loopcounter 1 'tracking items in set
If loopcounter > UBound(arr) Then
If addset = False Then
sets = sets 1 'adding final set if not already added
End If
Debug.Print start, sets
If best > sets Or best = 0 Then
best = sets 'Get the lowest value
End If
'resetting values
loopcounter = 0
sets = 0
start = start 1
i = start
If start > UBound(arr) Then
Exit Do
End If
End If
Loop
End With
Debug.Print best
轉載請註明出處，本文鏈接：https://www.uj5u.com/ruanti/521999.html