Передать значение из текстового поля пользовательской формы Excel 2016 в именованный диапазон, если он еще не находится в этом диапазоне

Question

У меня есть пользовательская форма Excel 2016, которая содержит текстовое поле и командную кнопку. Я хочу иметь возможность вводить имя или имена в текстовое поле, и пользовательская форма добавляет их в именованный диапазон после проверки на наличие дубликатов. Если имя уже находится в именованном диапазоне, я хочу, чтобы имя было добавлено в мою строку MsgAdd и продолжалось до следующей строки текстового поля (если применимо).

*** Новая попытка: Я впервые пытаюсь использовать словарь. Когда я пытаюсь использовать .Add вместо .Item, я получаю сообщение об ошибке для уже существующего значения. Словарь должен быть пустым в начале макроса? Мой именованный диапазон перебирается и добавляется. Затем dict.exist должен сработать, если значение существует, оно должно быть добавлено в мою строку сообщения, а если нет, то должно быть добавлено в конец именованного диапазона. Однако теперь значение добавляется к «A2» вместо конца диапазона и перезаписывается, если в текстовом поле более одной строки.

Private Sub AddAnalyst()
' Select Tools->References from the Visual Basic menu.
' Check box beside "Microsoft Scripting Runtime" in the list.
Dim ws          As Worksheet
Dim i           As Long
Dim FreeRow     As String
Dim TBLines()   As String
Dim MsgAdd      As String
Dim xFound      As Integer
Dim Cell        As Range
Dim Rng         As Range
Dim dict        As Object

Set Rng = Range("Name")

'Build Dictionary
Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare  'Capitalization does not apply

    For Each Cell In Rng.Cells 'Loop through range & add to dictionary
        dict.Item(Cell.Value) = Cell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
    Next Cell

    TBLines = Split(Add_Analyst_Form.AddAnalystTB.Text, vbCrLf)

    For i = LBound(TBLines) To UBound(TBLines)

        If dict.Exists(i) Then 'Add to message string for end msgbox
            xFound = xFound + 1
            MsgAdd = MsgAdd & vbCrLf & UBound(TBLines, i)
        Else
            With ws
                FreeRow = WorksheetFunction.CountA(Range("A:A")) + 1
                Sheets("Lists").Range("A" & FreeRow) = TBLines(i)
            End With
        End If
    Next i

If xFound <> 0 Then MsgBox ("Analyst(s)," & MsgAdd & ", is/are already entered into the database and will not be added.") 'msg name already exists

Set dict = Nothing   
End Sub

Ранее пробовал (до словаря):

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''   
Private Sub AddAnalyst()
Dim ws             As Worksheet
Dim i              As Long
Dim FreeRow        As String
Dim TBLines()      As String
Dim MsgAdd         As String
Dim sFind          As String
Dim rFound         As Range
Dim valueFound     As Integer

TBLines = Split(Add_Analyst_Form.AddAnalystTB.Text, vbCrLf) 

For i = LBound(TBLines) To UBound(TBLines) 'Cycle through all lines of the textbox

    On Error Resume Next 'Skip error that will occur if rFound does not exist.
    sFind = UBound(TBLines, i)
    Set rFound = Sheets("Lists").Range("Name").Find(sFind, LookIn:=xlValues, LookAt:=xlWhole)

    If Not rFound Is Nothing Then 'Add value to string for later MsgBox & increase integer
        valueFound = valueFound + 1
        MsgAdd = MsgAdd & vbCrLf & UBound(TBLines, i)
        GoTo NextIteration
    Else
        With ws 'Name is not duplicated in range, add to range.
            FreeRow = WorksheetFunction.CountA(Range("A:A")) + 1
            Sheets("Lists").Range("A" & FreeRow) = TBLines(i)
        End With
    End If
NextIteration:
Next i

'Msgbox will be displayed if 1 or more of the values previously existed.
If valueFound <> 0 Then MsgBox ("Analyst(s)," & MsgAdd & ", is/are already entered into the database and will not be added.") 'msg name already exists

End Sub

Кажется, мой скрипт не проверяет дубликаты. Это просто автоматически добавляет в конец моего именованного диапазона. Я думаю, что это из-за моего возобновления при ошибке, но я не могу найти способ обойти это. Если у кого-то есть вклад, это будет оценено.

Answer 1

Для всех, кто работает над чем-то похожим. Полностью запущен после добавления словаря и проработки нескольких других изломов.

Private Sub AddAnalyst()
' Select Tools->References from the Visual Basic menu.
' Check box beside "Microsoft Scripting Runtime" in the list.
Dim ws          As Worksheet
Dim i           As Integer
Dim FreeRow     As String
Dim TBLines()   As String
Dim MsgAdded    As String
Dim MsgExist    As String
Dim xFound      As Integer
Dim yFound      As Integer
Dim Cell        As Range
Dim dict        As Scripting.Dictionary

'Build Dictionary
Set dict = New Scripting.Dictionary
    dict.CompareMode = vbTextCompare  'Capitalization does not apply to dictionary

    For Each Cell In Range("Name").Cells 'Add named range to dictionary
        With Cell
            dict(Cell.Value) = Cell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
        End With
    Next Cell

    TBLines = Split(Add_Analyst_Form.AddAnalystTB.Text, vbCrLf) 'Split string when there are multiple lines

    For i = LBound(TBLines) To UBound(TBLines) 'Loop through split string
        If dict.Exists(TBLines(i)) Then
            xFound = xFound + 1
            MsgExist = MsgExist & vbCrLf & TBLines(i)
        Else
            With Sheets("Lists")
                FreeRow = .Range("A" & Rows.Count).End(xlUp).Row + 1 'First free row in Column A of Reasoning&Lists sheet
                .Range("A" & FreeRow) = TBLines(i)
            End With
            yFound = yFound + 1
            MsgAdded = MsgAdded & vbCrLf & TBLines(i)
        End If
    Next i
Set dict = Nothing

Unload Add_Analyst_Form 'Close out userform

If xFound <> 0 And yFound <> 0 Then
    MsgBox ("Analyst(s):" & MsgExist & vbCrLf & "already exists in the database and will not be added." & vbCrLf & vbCrLf & "Analyst(s):" & MsgAdded & vbCrLf & "have been added to the database.")
ElseIf xFound <> 0 And yFound = 0 Then
    MsgBox ("Analyst(s):" & MsgExist & vbCrLf & "already exists in the database and will not be added.") 'msg name already exists
ElseIf xFound = 0 And yFound <> 0 Then
    MsgBox ("Analyst(s):" & MsgAdded & vbCrLf & "have been added to the database.") 'msg name was added to database
End If

End Sub