Question

EDIT 感谢大家的见解！

你好的人（或者我应该说“世界”而不是？！^^），这是我的第一时间发布，因为我刚刚开始编写一些代码，主要是Excel的C和VBA！我有数学家背景，但我想深入研究编码世界！我希望我不会对这个感到厌倦！

此刻，我正试图制作一个VBA宏，以查找范围名称中的所有重复值，并将它们输出到另一范围的单元格中，但每个单元格只能一次。 IE（如果我的列表是“ John，John，Nick，John，George”），我想要的输出仅为John，而不是将名称“ John”高亮三遍。

下面是我的代码，我想到了创建 两个单独的集合 。第一个包含重复遍历名称范围的所有重复值，第二个仅包含每个重复的名称一次。然后，我仅使用 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结果是一个不错的选择，但可以在单个循环中完成。
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

我创建了VBA excel宏来查找重复的值，如何改善代码？

1 个答案: