Excel VBA Найти дубликаты и опубликовать на другом листе

Question

У меня все еще есть проблема с каким-то кодом в VBA. Excel искал какую-то помощь!

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

Пока мой код:

Sub main()
    Dim cName As New Collection
    For Each celli In Columns(3).Cells
    Sheets(2).Activate
        On Error GoTo raa
            If Not celli.Value = Empty Then
            cName.Add Item:=celli.Row, Key:="" & celli.Value
            End If
    Next celli
        On Error Resume Next
raa:
    Sheets(3).Activate
    Range("a1").Offset(celli.Row - 1, 0).Value = Range("a1").Offset(cName(celli.Value) - 1, 0).Value
    Resume Next
End Sub

Когда я пытаюсь запустить код, он вылетает в Excel и не дает никаких кодов ошибок.

Некоторые вещи, которые я пытался исправить:

• Сокращенный список элементов

• Преобразование телефонных номеров в строку с использованиемcstr ()

• Скорректированный диапазон и смещения

Я довольно новичок во всем этом, мне удалось продвинуться далеко в кодес помощью других постов на этом сайте.Не уверен, куда идти с этим, так как он просто дает сбой и не дает мне ошибки, чтобы разобраться.Любые идеи приветствуются Спасибо!

Обновлено:

Option Explicit
Dim output As Worksheet
Dim data As Worksheet
Dim hold As Object
Dim celli
Dim nextRow

Sub main()
    Set output = Worksheets("phoneFlags")
    Set data = Worksheets("filteredData")

    Set hold = CreateObject("Scripting.Dictionary")
        For Each celli In data.Columns(3).Cells
            On Error GoTo raa
            If Not IsEmpty(celli.Value) Then
                hold.Add Item:=celli.Row, Key:="" & celli.Value
            End If
        Next celli
        On Error Resume Next
raa:
    nextRow = output.Range("A" & Rows.Count).End(xlUp).Row + 1
    output.Range("A" & nextRow).Value = data.Range("A1").Offset(hold(celli.Value) - 1, 0).Value
    'data.Range("B1").Offset(celli.Row - 1, 0).Value = Range("B1").Offset(hold
    Resume Next
End Sub

Обновление2:

Используется hold.Exists вместе с ElseIf для удаленияGoTo.Также изменил его, чтобы скопировать и вставить строку на следующий лист.

Sub main()
    Set output = Worksheets("phoneFlags")
    Set data = Worksheets("filteredData")
    Set hold = CreateObject("Scripting.Dictionary")

    For Each celli In data.Columns(2).Cells
        If Not hold.Exists(CStr(celli.Value)) Then
            If Not IsEmpty(celli.Value) Then
                hold.Add Item:=celli.Row, Key:="" & celli.Value
            Else
            End If
        ElseIf hold.Exists(CStr(celli.Value)) Then
            data.Rows(celli.Row).Copy (Sheets("phoneFlags").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0))
            'output.Range("A" & nextRow).Value = data.Range("A1").Offset(hold(celli.Value) - 1, 0).Value
        End If
    Next celli
End Sub

Answer 1

При разработке кода не пытайтесь (или опасайтесь) ошибок, поскольку они являются указателями, помогающими исправить код или логику.Поэтому не используйте On Error, если это не указано абсолютно в алгоритме кодирования (*).использование On Error, когда в этом нет необходимости, только скрывает ошибки, не исправляет их, а при кодировании всегда лучше избегать ошибок в первую очередь (хорошая логика).

При добавлении в словарь сначала проверьтепосмотреть, если элемент уже существует.В документации Microsoft отмечается, что попытка добавить уже существующий элемент приводит к ошибке.Преимущество, которое объект Dictionary имеет перед обычным Collection объектом в VBA, - это метод .exists(value), который возвращает Boolean.

Короткий ответ на ваш вопрос, теперь, когда у меня естьконтекст в том, что вы можете сначала проверить (if Not hold.exists(CStr(celli.Value)) Then), а затем добавить, если он еще не существует.

(*) В качестве примечания я вчера решал проблему с макросом Excel, на которую у меня ушла большая часть дня, но возникновение ошибок и использование кода отладки помогли мне создать стабильный кода не какой-то глючный, но вроде работающий код (это то, что я исправлял в первую очередь).Тем не менее, использование обработки ошибок может быть сокращено в некоторых случаях, таких как:

Function RangeExists(WS as Worksheet, NamedRange as String) As Boolean
Dim tResult as Boolean
Dim tRange as Range
    tResult = False ' The default for declaring a Boolean is False, but I like to be explicit
    On Error Goto SetResult ' the use of error means not using a loop through all the named ranges in the WS and can be quicker.
        Set tRange = WS.Range(NamedRange) ' will error out if the named range does not exist
        tResult = True
    On Error Goto 0 ' Always good to explicitly limit where error hiding occurs, but not necessary in this example
SetResult:
    RangeExists = tResult
End Function