Question

我需要找到一种在一个单元格中显示多个值的方法。我还在'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列中的另一个单元格时，这些值才适应。
更改单元格将删除所选值。有没有办法重新确定单元格中的值并将其标记为已选择？
代码总是在更改到另一个单元格后添加值。有没有办法不允许重复？

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

Answer 1

我的解决方案基于您的示例进行了一些更改，以验证数据并初始化列表框。该设置遵循示例，并定义了一个命名范围内的国家/地区列表，然后创建一个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

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

1 个答案: