excel - VBA - Excel 2016 中单元格中多个值的复选框
问题描述
我需要找到一种在一个单元格中显示多个值的方法。我还通过“L42”( https://stackoverflow.com/a/23319627/10506941)的帖子找到了解决方案
这是我正在使用的当前代码:
Option Explicit
Dim fillRng As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Countries As MSForms.ListBox
Dim LBobj As OLEObject
Dim i As Long
Set LBobj = Me.OLEObjects("Countries")
Set Countries = LBobj.Object
If Not Intersect(Target, [AT:BB]) Is Nothing Then
Set fillRng = Target
With LBobj
.Left = fillRng.Left
.Top = fillRng.Top
.Width = fillRng.Width
.Visible = True
End With
Else
LBobj.Visible = False
If Not fillRng Is Nothing Then
With Countries
If .ListCount <> 0 Then
For i = 0 To .ListCount - 1
If fillRng.Value = "" Then
If .Selected(i) Then fillRng.Value = .List(i)
Else
If .Selected(i) Then fillRng.Value = _
fillRng.Value & "," & .List(i)
End If
Next
End If
For i = 0 To .ListCount - 1
.Selected(i) = False
Next
End With
Set fillRng = Nothing
End If
End If
End Sub
这绝对是我想要的方式。但是我有一些问题:
- 直到我在 AT 到 BB 列之外单击另一个单元格,这些值才会适应。
- 更改单元格会删除选定的值。有没有办法重新识别单元格中的值并将它们标记为已选中?
- 代码总是在更改到另一个单元格后添加值。有没有办法不允许重复?
有人能帮我吗?我是这个话题的新手,我没有任何线索了:/
解决方案
我的解决方案基于您的示例构建,并进行了一些更改以验证数据并初始化列表框。该设置遵循示例并在命名范围内定义国家列表,然后创建一个ListBox
使用该范围的多选。
回答您的问题“在我单击 AT 到 BB 列之外的另一个单元格之前,值不会适应”,这就是设计操作的方式。在用户选择另一个单元格之前,您不会知道用户已完成复选框。这是预期的动作。
我对您的代码进行了几处更改。首先是检查Target
范围以确保只选择了一个单元格。如果有多个选定的单元格并且代码运行,您可能会进入未知状态。
'--- we can only do one at a time
If Target.Cells.Count > 1 Then Exit Sub
接下来,我不假设所选单元格是空的。它很可能包含先前选择并添加到单元格中的国家列表。所以有一个私人例程将检查单元格中的列表,然后使用该列表重新选择列表框中的项目。
Private Sub SelectListBoxItems(ByRef thisListBox As MSForms.ListBox, _
ByRef valueList As Variant)
If UBound(valueList, 1) > 0 Then
Dim i As Long
Dim j As Long
With thisListBox
For i = 0 To .ListCount - 1
For j = LBound(valueList, 1) To UBound(valueList, 1)
If .List(i) = valueList(j) Then
.Selected(i) = True
End If
Next j
Next i
End With
End If
End Sub
所以在SelectionChange
主子中,代码如下所示:
If Not Intersect(Target, [B:C]) Is Nothing Then
Set fillRng = Target
With LBobj
.Left = fillRng.Left
.Top = fillRng.Top
.Width = fillRng.Width
Dim valueList As Variant
SelectListBoxItems countriesListBox, Split(fillRng, ",")
.Visible = True
End With
最后,确保在(重新)添加选择列表之前清除底层单元格。
这是整个代码模块:
Option Explicit
Private fillRng As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'--- we can only do one at a time
If Target.Cells.Count > 1 Then Exit Sub
Dim LBobj As OLEObject
Set LBobj = Me.OLEObjects("LB_colors")
Dim countriesListBox As MSForms.ListBox
Set countriesListBox = LBobj.Object
If Not Intersect(Target, [B:C]) Is Nothing Then
Set fillRng = Target
With LBobj
.Left = fillRng.Left
.Top = fillRng.Top
.Width = fillRng.Width
Dim valueList As Variant
SelectListBoxItems countriesListBox, Split(fillRng, ",")
.Visible = True
End With
Else
LBobj.Visible = False
If Not fillRng Is Nothing Then
fillRng.Value = vbNullString
With countriesListBox
If .ListCount <> 0 Then
Dim i As Long
For i = 0 To .ListCount - 1
If fillRng.Value = vbNullString Then
If .Selected(i) Then fillRng.Value = .List(i)
Else
If .Selected(i) Then fillRng.Value = _
fillRng.Value & "," & .List(i)
End If
Next
End If
For i = 0 To .ListCount - 1
.Selected(i) = False
Next
End With
Set fillRng = Nothing
End If
End If
End Sub
Private Sub SelectListBoxItems(ByRef thisListBox As MSForms.ListBox, _
ByRef valueList As Variant)
If UBound(valueList, 1) > 0 Then
Dim i As Long
Dim j As Long
With thisListBox
For i = 0 To .ListCount - 1
For j = LBound(valueList, 1) To UBound(valueList, 1)
If .List(i) = valueList(j) Then
.Selected(i) = True
End If
Next j
Next i
End With
End If
End Sub
推荐阅读
- javascript - useEffect 导致它调用该方法以获取帖子的次数太多。我只想在查询更改时获取帖子
- javascript - 使用 pandas 根据特定信息创建树
- c# - 将取消令牌从 Angular 传递到 MVC 应用程序到多个 API
- java - ExposedDropDown Menu 清除片段导航后的所有选项
- android-studio - 我切换到另一个应用程序后系统取消了我的服务
- reactjs - 单击按钮时实时获取或保存 axios.get 对 setState 的响应
- nginx - 使用 nginx 进行 ssh 隧道和代理网页的最佳方法
- python - Rock,Paper,Scissors With Bot,为什么我的程序没有打印出任何答案,即使我使用 ''s 定义了机器人移动?
- r - 删除 ggplot2 中 geom_ribbon 的图例键周围的填充
- rust - 检测窗口大小何时改变