问题
When I try to edit details of an existing item, my code fails to fill in the corresponding information for the last two items in the list. There is a combobox for selecting the item to edit, then a textbox for the item ID, as well as a textbox for the dates the item was ordered and when it was shipped, then two more comboboxes for selecting the shipping status and the online store it was purchased through. These fields are all auto-filled with the corresponding information for the item that is selected. The details corresponding to the selected item can be edited with the exception of the item name itself and the item ID. It works for every item EXCEPT the last 2 items and I have no idea why. Here is the code for editing an existing item:
Option Explicit
Private Sub cboOrderedFrom2_Change()
cboOrderedFrom2.BackColor = vbWhite
lblOrderedFrom2.ForeColor = vbBlack
End Sub
Private Sub cboOrderStatus2_Change()
cboOrderedFrom2.BackColor = vbWhite
lblOrderStatus2.ForeColor = vbBlack
End Sub
Private Sub cboRemoveOrEditItemDetails_Change()
cboRemoveOrEditItemDetails.BackColor = vbWhite
lblItemDescription2.ForeColor = vbBlack
Dim ws As Worksheet, i As Integer, wsLR As Variant
Set ws = ThisWorkbook.Sheets("Sheet1")
wsLR = ws.Cells(Rows.Count, 1).End(xlUp).Rows
For i = 3 To wsLR
If ws.Cells(i, 2) = Me.cboRemoveOrEditItemDetails Then
Me.txtItemID.Value = ws.Cells(i, "A")
Me.txtPiecesIncluded2.Value = ws.Cells(i, "C")
Me.txtOrderDate2.Value = ws.Cells(i, "E")
Me.cboOrderStatus2.Value = ws.Cells(i, "G")
Me.txtQuantityOrdered2.Value = ws.Cells(i, "D")
Me.txtDateShipped2.Value = ws.Cells(i, "F")
Me.cboOrderedFrom2.Value = ws.Cells(i, "H")
Exit Sub
End If
Next i
End Sub
Private Sub cmdAddStore_Click()
frmAddStore.Show
End Sub
Private Sub cmdCancelEditOrRemoveItemDetails_Click()
Unload Me
End Sub
'Private Sub cmdRemoveItemDetails_Click()
'Dim ws As Worksheet, i As Integer, wsLR As Variant
'Set ws = ThisWorkbook.Sheets("Sheet1")
'wsLR = ws.Cells(Rows.Count, 1).End(xlUp).Rows
'For i = 3 To wsLR
'If ws.Cells(i, 2) = Me.cboRemoveOrEditItemDetails Then
'Rows(i).EntireRow.Delete
'Sheet1.Activate
'Range("A1").End(xlDown).Offset(1, 0).Select
'ActiveCell.Value = ActiveCell.Offset(-1, 0).Value + 1
'Unload Me
'End If
'Next i
'End Sub
Private Sub cmdSubmitEditItemDetails_Click()
If txtPiecesIncluded2.BackColor = vbRed Then
Exit Sub
End If
If txtQuantityOrdered2.BackColor = vbRed Then
Exit Sub
End If
If cboOrderStatus2.BackColor = vbRed Then
Exit Sub
End If
If cboOrderedFrom2.BackColor = vbRed Then
Exit Sub
End If
If cboRemoveOrEditItemDetails.Value = "" Then
cboRemoveOrEditItemDetails.BackColor = vbRed
lblItemDescription2.ForeColor = vbRed
Exit Sub
End If
If cboRemoveOrEditItemDetails.BackColor = vbRed Then
Exit Sub
End If
Dim ws As Worksheet, i As Integer, wsLR As Variant
Set ws = ThisWorkbook.Sheets("Sheet1")
wsLR = ws.Cells(Rows.Count, 1).End(xlUp).Rows
For i = 3 To wsLR
If ws.Cells(i, "B") = Me.cboRemoveOrEditItemDetails Then
ws.Cells(i, "A") = Me.txtItemID.Value
ws.Cells(i, "C") = Me.txtPiecesIncluded2.Value
ws.Cells(i, "E") = Me.txtOrderDate2.Value
ws.Cells(i, "G") = Me.cboOrderStatus2.Value
ws.Cells(i, "D") = Me.txtQuantityOrdered2.Value
ws.Cells(i, "F") = Me.txtDateShipped2.Value
ws.Cells(i, "H") = Me.cboOrderedFrom2.Value
Unload Me
Exit Sub
End If
Next i
End Sub
Private Sub spnPiecesIncluded2_Change()
txtPiecesIncluded2.Value = spnPiecesIncluded2.Value
End Sub
Private Sub spnQuantityOrdered2_Change()
txtQuantityOrdered2.Value = spnQuantityOrdered2.Value
End Sub
Private Sub txtPiecesIncluded2_Change()
If IsNumeric(txtPiecesIncluded2.Value) And txtPiecesIncluded2.Value >= spnPiecesIncluded2.Min And _
txtPiecesIncluded2.Value <= spnPiecesIncluded2.Max Then
spnPiecesIncluded2.Value = txtPiecesIncluded2.Value
txtPiecesIncluded2.BackColor = vbWhite
lblPiecesIncluded2.ForeColor = vbBlack
Else
txtPiecesIncluded2.BackColor = vbRed
lblPiecesIncluded2.ForeColor = vbRed
End If
End Sub
Private Sub txtQuantityOrdered2_Change()
If IsNumeric(txtQuantityOrdered2.Value) And txtQuantityOrdered2.Value >= spnQuantityOrdered2.Min And _
txtQuantityOrdered2.Value <= spnQuantityOrdered2.Max Then
spnQuantityOrdered2.Value = txtQuantityOrdered2.Value
txtQuantityOrdered2.BackColor = vbWhite
lblQuantityOrdered2.ForeColor = vbBlack
Else
txtQuantityOrdered2.BackColor = vbRed
lblQuantityOrdered2.ForeColor = vbRed
End If
End Sub
Private Sub UserForm_Click()
End Sub
回答1:
Populating a ComboxBox
is pretty straight forward. The .List
property can accept an array, or you can add items individually with the .AddItem
method.
I notice from your code that you are reading each cell at a time in to your array. Are you aware that you can do it all in one go? Let's say your code to define the desired range looks something like this:
Dim lastRow As Long, lastCol As Long
Dim readRange As Range
'Define the range to be read
With Sheet1
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
lastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
Set readRange = .Range(.Cells(3, "A"), .Cells(lastRow, lastCol))
End With
Then the code to populate your array, could simply be one line:
Dim data As Variant
'Read range to array
data = readRange.Value2
The same applies to writing your array to a Worksheet
:
Dim writeRange As Range
'Write the data
Set writeRange = Sheet2.Range("A1").Resize(UBound(data, 1), UBound(data, 2))
writeRange.Value = data
Below are three examples of populating your ComboBox
with all or part of the array:
'Populate the combobox
UserForm1.ComboBox1.List = data
'Or, if you want more than one column in combobox
With UserForm1.ComboBox2
.ColumnCount = UBound(data, 2)
.List = data
End With
'Or, if you want a specific index (not the first) from your array
Dim r As Long, index As Long
index = 2
For r = 1 To UBound(data, 1)
UserForm1.ComboBox3.AddItem data(r, index)
Next
来源:https://stackoverflow.com/questions/42308318/how-do-i-populate-a-combobox-with-an-existing-array