采取列表框选择,将值添加到其他列表框,不允许重复
Take list box selection, add value to other list box without allowing duplicates
我正在制作的表格上有两个列表框。第一个列表框链接到具有各种公司名称的 table。我追求的目标是双击公司名称后,将值插入第二个列表框中。
在我尝试添加代码以防止重复项出现在第二个列表框中之前它工作正常,因此您不会意外地插入同一家公司两次。我尝试了几次不同的迭代,但没有成功。有人能帮忙解决这个问题吗?我的最终目标是 msgbox
弹出提醒用户不允许重复。
Private Sub ContractorLstbx_DblClick(Cancel As Integer)
Dim found As Boolean
found = False
Dim ID As Long
Dim Contractor As String
For Each newItem In Me.ContractorLstbx.ItemsSelected
For j = 0 To Me.SelectedContractorLst.ListCount - 1
If (Me!ContractorLstbx.ItemData(newItem).Column(1) = Me.SelectedContractorLst.ItemData(j).Column(1)) Then
found = True
Exit For
End If
Next j
If found = False Then
ID = Me.ContractorLstbx.ItemData(newItem)
Me.SelectedContractorLst.AddItem ContractorLstbx!.ItemData(newItem).Column(0) & ";" & Me!ContractorLstbx.ItemData(newItem).Column(1)
End If
found = False
Next newItem
End Sub
这是您的解决方案的完整代码。我在测试样品上试过它并且工作正常。只需复制并粘贴代码。如果您需要比较区分大小写(我的意思是 A <> a),请按照下面的代码使用 Option Compare Binary
。如果需要不区分大小写 (A = a),只需保留默认值 Option Compare Database
或更好地强制使用 Option Compare Text
Option Compare Binary
Private Sub ContractorLstbx_DblClick(Cancel As Integer)
Dim found As Boolean
found = False
Dim ID As Long
Dim Contractor As String
For i = 0 To Me.ContractorLstbx.ItemsSelected.Count - 1
For j = 0 To Me.SelectedContractorLst.ListCount - 1
If (Me.ContractorLstbx.Column(1, Me.ContractorLstbx.ItemsSelected(i)) = Me.SelectedContractorLst.Column(1, j)) Then
found = True
Exit For
End If
Next j
If found = False Then
ID = Me.ContractorLstbx.ItemData(Me.ContractorLstbx.ItemsSelected(i))
Me.SelectedContractorLst.AddItem (ContractorLstbx.Column(0, Me.ContractorLstbx.ItemsSelected(i)) & ";" & Me.ContractorLstbx.Column(1, Me.ContractorLstbx.ItemsSelected(i)))
End If
found = False
Next i
End Sub
我正在制作的表格上有两个列表框。第一个列表框链接到具有各种公司名称的 table。我追求的目标是双击公司名称后,将值插入第二个列表框中。
在我尝试添加代码以防止重复项出现在第二个列表框中之前它工作正常,因此您不会意外地插入同一家公司两次。我尝试了几次不同的迭代,但没有成功。有人能帮忙解决这个问题吗?我的最终目标是 msgbox
弹出提醒用户不允许重复。
Private Sub ContractorLstbx_DblClick(Cancel As Integer)
Dim found As Boolean
found = False
Dim ID As Long
Dim Contractor As String
For Each newItem In Me.ContractorLstbx.ItemsSelected
For j = 0 To Me.SelectedContractorLst.ListCount - 1
If (Me!ContractorLstbx.ItemData(newItem).Column(1) = Me.SelectedContractorLst.ItemData(j).Column(1)) Then
found = True
Exit For
End If
Next j
If found = False Then
ID = Me.ContractorLstbx.ItemData(newItem)
Me.SelectedContractorLst.AddItem ContractorLstbx!.ItemData(newItem).Column(0) & ";" & Me!ContractorLstbx.ItemData(newItem).Column(1)
End If
found = False
Next newItem
End Sub
这是您的解决方案的完整代码。我在测试样品上试过它并且工作正常。只需复制并粘贴代码。如果您需要比较区分大小写(我的意思是 A <> a),请按照下面的代码使用 Option Compare Binary
。如果需要不区分大小写 (A = a),只需保留默认值 Option Compare Database
或更好地强制使用 Option Compare Text
Option Compare Binary
Private Sub ContractorLstbx_DblClick(Cancel As Integer)
Dim found As Boolean
found = False
Dim ID As Long
Dim Contractor As String
For i = 0 To Me.ContractorLstbx.ItemsSelected.Count - 1
For j = 0 To Me.SelectedContractorLst.ListCount - 1
If (Me.ContractorLstbx.Column(1, Me.ContractorLstbx.ItemsSelected(i)) = Me.SelectedContractorLst.Column(1, j)) Then
found = True
Exit For
End If
Next j
If found = False Then
ID = Me.ContractorLstbx.ItemData(Me.ContractorLstbx.ItemsSelected(i))
Me.SelectedContractorLst.AddItem (ContractorLstbx.Column(0, Me.ContractorLstbx.ItemsSelected(i)) & ";" & Me.ContractorLstbx.Column(1, Me.ContractorLstbx.ItemsSelected(i)))
End If
found = False
Next i
End Sub