Excel VBA for Uniques答案

【问题标题】：Excel VBA for UniquesExcel VBA for Uniques
【发布时间】：2019-10-07 09:10:08
【问题描述】：

我希望以右侧给出的格式提取 Unique。我在其中一个论坛站点上找到了 VBA 代码，但这个不适合我。有没有办法修改代码或编写更好的东西。我确实有一个公式，但是公式非常耗费资源，而且非常大的 Excel 加载速度非常慢。

Sub FindDistinctValues()
Dim LastRowFrom As Long
Dim LastRowTo As Long
Dim i As Long, j As Long
Dim temp As Integer
Dim found As Boolean
'determines the last row that contains data in column A
LastRowFrom = Range("A" & Rows.Count).End(xlUp).Row
'Loop for each entry in column A
For i = 2 To LastRowFrom
'get the next value from column A
temp = Range("A" & i).Value

'Determine the last row with data in column B
LastRowTo = Range("B" & Rows.Count).End(xlUp).Row

'initialize j and found
j = 1
 found = False

     'Loop through "To List" until a match is found or the list has been    searched
      Do
      'check if the value exists in B column
      If temp = Range("B" & j).Value Then
     found = True
     End If
     'increment j
    j = j + 1
     Loop Until found Or j = LastRowTo + 1

    'if the value is not already in column B
    If Not found Then
   Range("B" & j).Value = temp
  End If
Next i
End Sub

【问题讨论】：

我看到图片没有发布所以在这里发布，而是因为试图加载图片而导致代码混乱。 prntscr.com/cmwobj
感谢 Slai 的编辑。
您需要在列表中动态执行此操作还是仅此一项？
您是在寻找实际的唯一值还是只是在 Col D 中值不同的地方？例如，456 和 813 在该列表中不是唯一的，而 243 和 213 是。
prntscr.com/cmy8at 很抱歉造成混乱。我应该只使用一张截图。我正在寻求实现这一目标。 D 列会出现，我需要达到 E 列。因为这是一个持续的练习。我正在尝试使用 VBA 来实现。目前我使用公式，这对于非常大的数据非常慢。

标签： excel vba

【解决方案1】：

我没有测试过，但是是这样的：

Sub FindDistinctValues()
    Dim dict As Object, cell As Range
    Set dict = CreateObject("Scripting.Dictionary")

    For Each cell in Range("A1").CurrentRegion.Resize(, 1)
        If Not dict.Exists(cell & "")
            cell(, 2) = "Unique"
            dict.Add cell & "", 0
        End If
    Next
End Sub

【讨论】：