我有一个我希望能够自动化的列表框，这样当我输入一个项目的总数量时，它将多次选择行直到达到该总数。在MS Access的范围内我想做什么？我一直在搜索和搜索，似乎无法找到任何东西来告诉我从哪里开始。
' Spin through the Array adding up rows to fulfill the needed quantity, following will search and possibly use part of a BIN
If ListArray(i, 1) <> "" And ListArray(i, 1) <= iQty Then ' skip empty array; check if less than qty
While index <= Me.lstShipping.ListCount
lstShipping(ListArray(i, 0)) = True ' select this row in ListBox
iSelected = iSelected + ListArray(i, 1) ' track total qty selected
If iSelected = iQty Then ' if enough is selected, end
Exit While
End If
index += 1
End While
答案 0 :(得分：0)
更新以添加缺少的功能...以下代码将在您的列表框中旋转，寻找匹配的“Lot＃”并选择将提供所需数量的行。列表框数量被放入一个数组中，然后进行排序，这样它将需要最小的数量来释放大多数垃圾箱。我懒得让代码取消选择多个先前选择的行来达到正确的数量，但msgbox会提醒你。只需调用传递数量和Lot＃的函数。
Option Compare Database
Option Explicit
Dim myarray() As Variant
Private Sub cmdSearchBins_Click()
Mark_ListBox_Rows Me.txtQty, "Lot-A"
End Sub
Function Mark_ListBox_Rows(Qty As Integer, LotNbr As String)
Dim i As Integer
Dim i2 As Integer
Dim iStart As Integer
Dim iQty As Integer
Dim iReserved As Integer
Dim iAddRow As Integer
Dim iColUsed As Integer
Dim iMaxQtyAvail As Integer
'(1)Either pass the qty (and Lot #) to this routine, or change code to get Qty from another control and set iQty
'(2) Modify code for correct column (I am using col 4 (3 if relative to zero))
'(3) Most times automatic selection will be made. If unable to find simple (one row) solution, let the user pick.
iColUsed = 3 ' (relative to zero)
iMaxQtyAvail = 0
If IsNull(Qty) Or Qty = 0 Then
MsgBox "You must specify the Quantity!", vbOKOnly, "No Quantity Entered"
Exit Function
End If
If Me.List2.ColumnHeads = True Then ' Check if listbox has headings
iStart = 1 ' Adjust starting row + 1
Else
iStart = 0
End If
ReDim myarray(Me.List2.ListCount, 2) 'Resize Array as needed
'Populate Array with ListBox Row & Qty
i2 = 0
For i = 0 To Me.List2.ListCount ' Spin through listbox
If Me.List2.Column(2, iStart + i) = LotNbr Then ' Make sure Lot # matches
If Me.List2.Column(iColUsed, iStart + i) <> 0 Then ' Make sure not = 0 (doubt it is in your list, but...)
myarray(i2, 0) = iStart + i2 ' Save Row number, then Qty
myarray(i2, 1) = Int(Me.List2.Column(iColUsed, iStart + i))
iMaxQtyAvail = iMaxQtyAvail + Int(Me.List2.Column(iColUsed, iStart + i))
'Debug.Print "List Row: " & i2 & vbTab & "Qty: " & myarray(i2, 1)
i2 = i2 + 1
End If
End If
Next i
If iMaxQtyAvail < Qty Then
MsgBox "All rows combined only have a quantity of: " & iMaxQtyAvail & vbCrLf & "You asked for quantity of : " & Qty, vbOKOnly, "Insufficient Quantity Available"
GoTo End_Here
End If
myarray = BubbleSrt(myarray, True) ' Sort my Array by Quantity
' For i = 0 To UBound(myarray) ' List what the Array looks like after sorting.
' Debug.Print "Array: " & i & vbTab & myarray(i, 0) & " - " & myarray(i, 1)
' Next i
iQty = Qty
iReserved = 0
For i = 0 To Me.List2.ListCount 'Deselect ALL rows in Listbox - in case someone already started....
List2.Selected(i) = False
Next i
For i = 0 To UBound(myarray) ' Spin through the Array adding up rows to fulfill the desired quantity
'The following will search and possibly use part of a bin.
If myarray(i, 1) <> "" And myarray(i, 1) <= iQty Then ' Skip empty Array; check if <= Qty
If iReserved + myarray(i, 1) <= iQty Then
'Debug.Print "Row: " & myarray(iStart + i, 0) & vbTab & "Qty: " & myarray(iStart + i, 1)
List2.Selected(myarray(i, 0)) = True ' Select this row in Listbox
iReserved = iReserved + myarray(i, 1) ' Keep track of total reserved so far
If iReserved = iQty Then ' If just the right number, get outta here!
'Me.txtReserved = iReserved
GoTo End_Here
End If
Else ' Need to Adjust
' Not so simple. Need to see if can deselect a prior selected row and keep this row to arrive at total.
'Debug.Print "Need to Adjust; Qty Required / Current Reserved + ListItem = " & Qty & " / " & iReserved + myarray(iStart + i, 1)
iAddRow = i ' Save the row with the qty that would put us over the limit.
For i2 = iStart + i To 1 Step -1 ' Walk backwards so we deselect largest qty.
If ((iReserved + myarray(iAddRow, 1)) - myarray(i2, 1)) = iQty Then
' Found the right combination. Deselect this row, and select the row from earlier
'Debug.Print "Swap Rows"
List2.Selected(myarray(i2, 0)) = False ' Unselect this row in Listbox
List2.Selected(myarray(iAddRow, 0)) = True ' Select this row in Listbox
iReserved = iReserved + myarray(iAddRow, 1) - myarray(i2, 1) ' Count Total Reserved
'Me.txtReserved = iReserved
GoTo End_Here
End If
Next i2
' Yikes! I don't frrl like coding to handle deselecting some combination of 2 or more!!!
MsgBox "Qty Needed = " & Qty & vbCrLf & "Qty selected = " & iReserved & vbCrLf & vbCrLf & "Please manually select/deselect to obtain desired quantity", vbOKOnly, "Manually Select Quantity"
GoTo End_Here
End If
End If
Next i
If iQty > iReserved Then
MsgBox "Unable to find sufficient part quantity!", vbOKOnly, "Not Enough Parts"
'Deselect ALL
For i = 0 To Me.List2.ListCount
List2.Selected(i) = False
Next i
End If
End_Here:
'Me.txtQty = Me.txtQty + 1
End Function
Public Function BubbleSrt(ArrayIn As Variant, Ascending As Boolean)
Dim SrtTemp As Variant
Dim i As Long
Dim j As Long
Dim SrtTemp0 As Variant
Dim SrtTemp1 As Variant
If Ascending = True Then
For i = LBound(ArrayIn) To UBound(ArrayIn)
For j = i + 1 To UBound(ArrayIn)
If ArrayIn(i, 1) > ArrayIn(j, 1) Then
SrtTemp0 = ArrayIn(j, 0)
SrtTemp1 = ArrayIn(j, 1)
ArrayIn(j, 0) = ArrayIn(i, 0)
ArrayIn(j, 1) = ArrayIn(i, 1)
ArrayIn(i, 0) = SrtTemp0
ArrayIn(i, 1) = SrtTemp1
End If
Next j
Next i
Else
For i = LBound(ArrayIn) To UBound(ArrayIn)
For j = i + 1 To UBound(ArrayIn)
If ArrayIn(i) < ArrayIn(j) Then
SrtTemp = ArrayIn(j)
ArrayIn(j) = ArrayIn(i)
ArrayIn(i) = SrtTemp
End If
Next j
Next i
End If
BubbleSrt = ArrayIn
End Function