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

Question

Я пытаюсь скопировать строку значений в один столбец на новом листе.Мой код работает, когда в активной ячейке есть только одно значение, но копирует каждое значение в ячейку, если имеется несколько значений.Я хочу, чтобы он копировал только самые последние дополнения в колонку на новом листе.Входные данные - это выбор из выпадающего меню, в котором можно выбрать несколько элементов.Затем эти выборки разделяются и смещаются в новую ячейку на 9 столбцов (у меня также есть другие раскрывающиеся списки, поэтому здесь так много места, но больший цикл должен обрабатывать другие раскрывающиеся списки).

Это изображение ввода:

Это то, что я сейчас получаю в качестве вывода:

Это мой желаемый вывод:

If InStr(1, Oldvalue, Newvalue) = 0 Then
            Target.Value = Oldvalue & "; " & Newvalue
            Dim txt As String
            Dim i As Integer
            Dim FullName As Variant

            txt = ActiveCell.Value

            FullName = Split(txt, ";")

            For i = 1 To UBound(FullName)
                ActiveCell.Offset(i, 9).Value = FullName(i)
                ActiveCell.Offset(i, 9).Copy
                Worksheets("Links").Range("A3").End(xlUp).Offset(2, 0).Insert
            Next i

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

Answer 1

Мое лучшее предположение заключается в том, что при обнаружении изменения вы хотите обновить отдельный список значений в 9 ячеек?

Сейчас вы уже управляете одним отдельным списком.Все, что вам нужно сделать, это очистить значения в ячейках столбца 9, а затем распечатать значения в раскрывающемся списке.

Private Sub Worksheet_Change(ByVal Target As Range)
'Code by Sumit Bansal from https://trumpexcel.com
' To allow multiple selections in a Drop Down List in Excel (without repetition)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Address = "$A$1" Then
    If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
        GoTo Exitsub
    Else:
        If Target.Value = "" Then GoTo Exitsub Else
            Application.EnableEvents = False
            Newvalue = Target.Value
            Application.Undo
            Oldvalue = Target.Value
            If Oldvalue = "" Then
                Target.Value = Newvalue
            Else
                If InStr(1, Oldvalue, Newvalue) = 0 Then
                    Target.Value = Oldvalue & "; " & Newvalue

                Else:
                    Target.Value = Oldvalue
                End If

            End If
        Dim txt As String
        Dim i As Integer
        Dim FullName As Variant

        txt = ActiveCell.Value

        FullName = Split(txt, ";")
        ActiveCell.Offset(, 9).EntireColumn.Clear
        For i = 0 To UBound(FullName)

            ActiveCell.Offset(i, 9) = Trim(FullName(i))
        Next i
    End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub

Но что, если я хочу отдельный список из более чем одного раскрывающегося списка или;массив с разделителями?Лучший способ управлять отдельным списком - это объект Collection или Dictionary.

Если это то, что вы ищете, я обновлю этот ответ способом использования этих объектов.

---

На основе ваших отзывов я обновил код ниже, чтобы использовать объект коллекции для управления вашим отдельным списком из нескольких раскрывающихся списков.

Option Explicit

Private col As Collection
'  ^ we are defining this to the module level. That means it will retain values
'    and be able to be referenced from any other place in the project.
Private Sub Worksheet_Change(ByVal Target As Range)
    'Code by Sumit Bansal from https://trumpexcel.com
    ' To allow multiple selections in a Drop Down List in Excel (without repetition)
    Dim Oldvalue As String
    Dim Newvalue As String
    Application.EnableEvents = True
    On Error GoTo Exitsub
    If Not Intersect(Target, Range("$A$1:$B$1")) Is Nothing Then
    '      ^ this will make the area your looking more specific than just .row = 11
    '        you could also replace the address with a namedRange
        If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
            GoTo Exitsub
        Else:
            If Target.Value = "" Then
                '' My guess is that here you would want to make a call to a function that
                '' removes values from the function. You should be able to loop over the collection
                '' to find the value to remove.
                GoTo Exitsub
            Else
                Application.EnableEvents = False
                Newvalue = Target.Value
                Application.Undo
                Oldvalue = Target.Value
                If Oldvalue = "" Then
                    Target.Value = Newvalue
                Else
                    If InStr(1, Oldvalue, Newvalue) = 0 Then
                        Target.Value = Oldvalue & "; " & Newvalue

                    Else:
                        Target.Value = Oldvalue
                    End If

                End If
            ManageList Newvalue
            '          ^ you already have the newest value. You just need a easy way to check if it
            '            is in the list. To do this I made a sub that receives text, and checks
            '            if it is in the publicly scoped collection.
            End If
        End If
    End If
    Application.EnableEvents = True
Exitsub:
    Application.EnableEvents = True
End Sub

Private Sub ManageList(txt As String)
' This Sub will receive a text value and try to put it in a collection. 

If col Is Nothing Then Set col = New Collection

On Error Resume Next
col.Add Item:=txt, Key:=txt
'  ^ this method will throw an error if the Key is already in the collection.
'    all we need to do then is watch for errors, and handle if we found a new one.
'    I have found that collections and dictionary objects can handle .5M keys without any issues.
'    using a dictionary, would allow you to test for a key without defining an error handler.
'    with the trade off being that you have to add an additional reference to your project.
If Err.Number = 0 Then
    ' we had a new value
    PrintList col
End If
End Sub

Private Sub PrintList(col As Collection)
Dim printTo As Range
Dim i As Long
Set printTo = Range("e1")
'                    ^ change e1 to a fully qualified address of where you
'                      want you list to be printed.
printTo.EntireColumn.Clear
On Error GoTo eos:
For i = 0 To col.Count - 1
    printTo.Offset(i) = col(i + 1)
Next
eos:
End Sub