Как написать код для щелчка и выбора нескольких значений и ввода одной ячейки с разделением запятыми

Question

Я пытаюсь написать код в Excel, который позволяет мне щелкать и выбирать несколько значений и вводить их в одну ячейку с разделением запятыми.

Прикрепленный снимок экрана показывает, как я sh достигну Окончательный результат в желтых полях, чтобы выбрать, нажав несколько значений и введите их в ячейку на листе Excel.

Я пытаюсь набросать код ниже на листе 1, но он не работает: -

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.CountLarge <> 1 Then Exit Sub
    If Target.Row < 10 Or Target.Row > 101 Then Exit Sub
    If Intersect(Me.Range("C:C,E:E, G:G"), Target) Is Nothing Then Exit Sub  
    Me.Cells(7, Target.Column).Value = Target.Value
    Active.Cell= Range("E10")& Range("E11")& Range("E12")& Range("E13") & Range ("E14") & Range ("E15") & Range("E16')& (Range"E17")  
End Sub

Я пытаюсь, но не могу выбрать несколько вариантов размещения в одной ячейке; и я также не мог получить разделение запятыми в желтом поле множественного выбора. Буду признателен, если вы поможете исправить мою ошибку.

Большое спасибо.

Answer 1

Вы хотите сказать, что хотите щелкнуть (и, таким образом, выбрать) каждую ячейку, и она должна добавить эту ячейку? Первая строка в вашем коде проверяет, выбраны ли несколько ячеек, и игнорирует выбор, если это так. Итак, я предполагаю, что простой щелчок по ячейке должен добавить его? Я не совсем понимаю логи c последнего ряда. После того, как кто-то что-то выбрал, вы хотите, чтобы макрос выбрал диапазон E10-17?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Cells.Count <> 1 Then Exit Sub
    If Target.Row < 10 Or Target.Row > 101 Then Exit Sub
    If Intersect(Me.Range("C:C,E:E, G:G"), Target) Is Nothing Then Exit Sub


    If Me.Cells(7, Target.Column).Value = "" Then
        Me.Cells(7, Target.Column).Value = Target.Value
    Else
        Me.Cells(7, Target.Column).Value = Me.Cells(7, Target.Column).Value & ", " & Target.Value
    End If

    'Really?
    'Range("E10:E17").Select

End Sub

Я добавил оператор if, чтобы добавить первую запись после очистки желтого поля. Кажется, работает на меня.