Я создал макрос VBA excel для поиска повторяющихся значений. Как я могу улучшить свой код?

Question

РЕДАКТИРОВАТЬ Спасибо за понимание всем!

Привет человек (или лучше сказать "Мир"?! ^^)Я впервые пишу здесь, так как я только начал писать код, в основном C и VBA для Excel!У меня есть опыт работы в области математики, но я бы хотел окунуться в мир программирования!Надеюсь, я не буду вас сильно утомлять этим!

В данный момент я пытаюсь создать макрос VBA, чтобы найти все повторяющиеся значения в именах диапазонов и вывести их в другой диапазон ячеек. но только один раз .То есть, если мой список «Джон, Джон, Ник, Джон, Джордж», то вывод, который я хочу, - это только Джон, вместо того, чтобы выделять имя «Джон» три раза.

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

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

В основном Я хотел бы, чтобы ваш вклад и мысли о моем коде.Сколько очков получает мой код, функционально и визуально.Мог ли я сделать что-то по-другому?Могу ли я иметь купол что-то лучше?Здесь я должен отметить, что меня интересует только код, а не функции Excel в целом.Это просто для практики кода VBA!Спасибо за ваше время!

  Option Explicit

Sub FindUniqueDuplicates()

     Dim vRange1 As Variant, vRange2 As Range, vRange3 As Range  '''''''''''''''''''''''''
     Dim vCell1 As Range, vCell2 As Range, vCell3 As Range       '''''  Declarations '''''
     Dim i As Integer, k As Integer, l As Integer                '''''''''''''''''''''''''
     Dim vBool1 As Boolean, vBool2 As Boolean
     Dim vColl As Collection, vColl2 As Collection

     Set vRange1 = Range(Range("A1").End(xlUp), Range("A1").End(xlDown).Offset(-1, 0))
     Set vColl = New Collection
     'Debug.Print vColl.Count
     For Each vCell1 In vRange1
          vCell1.Activate
          Set vRange2 = Range(vCell1.Offset(1, 0), Range("A1").End(xlDown))

          For Each vCell2 In vRange2
               vCell2.Activate
               'Debug.Print vCell1.Value, vCell2.Value
               If vCell1.Value = vCell2.Value Then
                    vColl.Add vCell1.Value
               End If
          Next
          'Debug.Print
     Next
     'Debug.Print 'break point

     Set vColl2 = New Collection
     vColl2.Add vColl.Item(1)                          ''''' set vColl2 as new collection to hold
     k = 1                                             ''''' only the unique values from the range


     For i = 1 To vColl.Count
          vBool1 = False
          For k = 1 To vColl2.Count
          Debug.Print vColl2.Item(k), vColl.Item(i)
               If vColl.Item(i) = vColl2.Item(k) Then
                    vBool1 = True                      ''''' Condition to check if vColl2 holds
                    Exit For                           ''''' the value already
               End If
          Next
          If vBool1 = False Then                       ''''' Append the unique value to vColl2
               vColl2.Add vColl.Item(i)
          End If
     Next

     'Debug.Print 'break point

     Range("B1").Select
     ActiveCell.Value = "These are the duplicate names"
     For k = 1 To vColl2.Count
          Cells(k + 1, 2).Value = vColl2.Item(k)
     Next
     Columns.AutoFit
End Sub

Answer 1

Пара основных пунктов:

• Существует несколько способов обнаружения дубликатов.Построение двух коллекций (или словарей) для результата trck - хороший вариант, но это можно сделать за один цикл.
• A Dictionary предлагает три важных преимущества: он предлагает .Exists, что делает добавление уникальнымэлемент легко, он предлагает свойство .Items, которое облегчает размещение результата на листе, и в этом случае это быстрее.
  • Вам нужно будет добавить ссылку на Microsoft Scripting Runtime или преобразовать в Late Binding (Примечание: только для Windows, у Mac нет этой опции)

Другие пункты:

• Именование переменной: нет необходимости в префиксе, она не добавляет ничего полезного
• Используйте Long вместо Integer
• Не используйте Select, создавайте объекты для ссылки на лист и диапазон вместо
• Скопируйте диапазон данных в Variant Array и зациклите его.Гораздо быстрее, чем зацикливание диапазона
• Поместите весь диапазон результатов на листе за один раз, опять же намного быстрее
• Удалите все старые данные с листа перед возвратом результатов
• .End(xlUp) обычно предпочтительнее.Это гарантирует, что пробелы в диапазоне данных не будут сокращать диапазон - YMMV

Примерно так

Function UniqueDuplicates(rng As Range) As Variant
    Dim Dat As Variant
    Dim Dict As Dictionary, Dict2 As Dictionary
    Dim rw As Long

    ' Copy to Variant Array for speed
    Dat = rng.Value2
    Set Dict = New Dictionary
    Set Dict2 = New Dictionary
    For rw = 1 To UBound(Dat, 1)
        If Dict.Exists(Dat(rw, 1)) Then
            ' Its already noted, check if its already listed as a dup
            If Not Dict2.Exists(Dat(rw, 1)) Then Dict2.Add Dat(rw, 1), 1
        Else
            ' Add to already noted values
            Dict.Add Dat(rw, 1), 1
        End If
    Next
    ' return Unique set of Duplicates
    If Dict2.Count > 0 Then
        UniqueDuplicates = Application.Transpose(Dict2.Keys)
    End If
End Function

Использовать вот так

Sub Demo()
    Dim rng As Range
    Dim res As Variant

    With ActiveSheet
        Set rng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    End With
    res = UniqueDuplicates(rng)
    With rng.EntireColumn.Offset(0, 1)
        .ClearContents
        .Resize(UBound(res), 1) = res
    End With
End Sub