VBA - Флажок для нескольких значений в ячейке в Excel 2016

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