VBA

Question

我需要找到一种在一个单元格中显示多个值的方法。我还通过 'L42' ()

的 post 找到了解决方案

这是我当前使用的代码：

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 列之外的另一个单元格之前，这些值不会调整。
更改单元格会删除选定的值。有没有办法重新确定单元格中的值并将它们标记为已选择？
代码总是在更改到另一个单元格后添加值。有没有办法不允许重复？

有人可以帮助我吗？我是这个话题的新手，我没有任何线索了：/

Answer 1

我的解决方案基于您的示例构建，并进行了一些更改以验证数据和初始化列表框。该设置遵循示例并定义命名范围内的国家/地区列表，然后创建一个 ListBox，该范围使用 multi-select.

针对您的问题"The values won't adapt untill I click another cell abroad the column AT to BB"，动作是这样设计的。在用户 select 另一个单元格之前，您不会知道用户已完成复选框。这是预期的操作。

我对您的代码做了几处更改。第一个是检查 Target 范围以确保只有一个单元格 selected。如果有多个 selected 单元格并且代码运行，您可能会进入未知状态。

'--- we can only do one at a time
If Target.Cells.Count > 1 Then Exit Sub

接下来，我不假设 selected 单元格为空。它很可能包含以前 select 编辑并添加到单元格中的国家/地区列表。所以有一个私有例程会检查单元格中的列表，然后使用该列表重新 select 列表框中的项目。

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

最后，确保在（重新）添加 select 离子列表之前清除底层单元格。

这是整个代码模块：

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

VBA - Excel 2016 年单元格中多个值的复选框

VBA - Checkbox for multiple values in a cell in Excel 2016

excel

checkbox

excel-2016