使用 VBA 在 excel 中创建列表/数组以获取列中唯一名称的列表

Question

我正在尝试在列中创建一个唯一名称列表，但我一直不明白如何正确使用 ReDim，有人可以帮我完成这个并解释它是如何完成的，或者更好地建议一个更好的替代方案/更快的方式。

Sub test()
    LastRow = Range("C65536").End(xlUp).Row
    For Each Cell In Range("C4:C" & LastRow)
        OldVar = NewVar
        NewVar = Cell
        If OldVar <> NewVar Then
            `x =...
        End If
    Next Cell
End Sub

我的数据格式为：

Stack
Stack
Stack
Stack
Stack
Overflow
Overflow
Overflow
Overflow
Overflow
Overflow
Overflow
Overflow
.com
.com
.com

所以本质上，一旦它有了名字，它就再也不会在列表中再次弹出了。

最后，数组应包含：

堆 溢出 .com

Answer 1

您不需要数组。尝试类似：

ActiveSheet.Range("$A$1:$A$" & LastRow).RemoveDuplicates Columns:=1, Header:=xlYes

如果没有标题，请相应更改。

编辑：这是传统方法，它利用Collection 中的每个项目必须具有唯一键的事实：

Sub test()
Dim ws As Excel.Worksheet
Dim LastRow As Long
Dim coll As Collection
Dim cell As Excel.Range
Dim arr() As String
Dim i As Long

Set ws = ActiveSheet
With ws
    LastRow = .Range("C" & .Rows.Count).End(xlUp).Row
    Set coll = New Collection
    For Each cell In .Range("C4:C" & LastRow)
        On Error Resume Next
        coll.Add cell.Value, CStr(cell.Value)
        On Error GoTo 0
    Next cell
    ReDim arr(1 To coll.Count)
    For i = LBound(arr) To UBound(arr)
        arr(i) = coll(i)
        'to show in Immediate Window
        Debug.Print arr(i)
    Next i
End With
End Sub

Answer 2

您可以尝试我的建议，以解决 Doug 的方法。
但是如果你想坚持你的逻辑，你可以试试这个：

Option Explicit

Sub GetUnique()

Dim rng As Range
Dim myarray, myunique
Dim i As Integer

ReDim myunique(1)

With ThisWorkbook.Sheets("Sheet1")
    Set rng = .Range(.Range("A1"), .Range("A" & .Rows.Count).End(xlUp))
    myarray = Application.Transpose(rng)
    For i = LBound(myarray) To UBound(myarray)
        If IsError(Application.Match(myarray(i), myunique, 0)) Then
            myunique(UBound(myunique)) = myarray(i)
            ReDim Preserve myunique(UBound(myunique) + 1)
        End If
    Next
End With

For i = LBound(myunique) To UBound(myunique)
    Debug.Print myunique(i)
Next

End Sub

这使用数组而不是范围。
它还使用Match 函数而不是嵌套的For Loop。
不过，我没有时间检查时差。
所以我把测试留给你。

Answer 3

FWIW，这是字典。设置对 MS Scripting 的引用后。您可以使用 avInput 的数组大小来满足您的需求。

Sub somemacro()
Dim avInput As Variant
Dim uvals As Dictionary
Dim i As Integer
Dim rop As Range

avInput = Sheets("data").UsedRange
Set uvals = New Dictionary


For i = 1 To UBound(avInput, 1)
    If uvals.Exists(avInput(i, 1)) = False Then
        uvals.Add avInput(i, 1), 1
    Else
        uvals.Item(avInput(i, 1)) = uvals.Item(avInput(i, 1)) + 1
    End If
Next i

ReDim avInput(1 To uvals.Count)
i = 1

For Each kv In uvals.Keys
    avInput(i) = kv
    i = i + 1
Next kv

Set rop = Sheets("sheet2").Range("a1")
rop.Resize(UBound(avInput, 1), 1) = Application.Transpose(avInput)




End Sub

Answer 4

受 VB.Net Generics List(Of Integer) 的启发，我为此创建了自己的模块。也许您发现它也很有用，或者您想扩展其他方法，例如再次删除项目：

'Save module with name: ListOfInteger

Public Function ListLength(list() As Integer) As Integer
On Error Resume Next
ListLength = UBound(list) + 1
On Error GoTo 0
End Function

Public Sub ListAdd(list() As Integer, newValue As Integer)
ReDim Preserve list(ListLength(list))
list(UBound(list)) = newValue
End Sub

Public Function ListContains(list() As Integer, value As Integer) As Boolean
ListContains = False
Dim MyCounter As Integer
For MyCounter = 0 To ListLength(list) - 1
    If list(MyCounter) = value Then
        ListContains = True
        Exit For
    End If
Next
End Function

Public Sub DebugOutputList(list() As Integer)
Dim MyCounter As Integer
For MyCounter = 0 To ListLength(list) - 1
    Debug.Print list(MyCounter)
Next
End Sub

您可以在代码中按如下方式使用它：

Public Sub IntegerListDemo_RowsOfAllSelectedCells()
Dim rows() As Integer

Set SelectedCellRange = Excel.Selection
For Each MyCell In SelectedCellRange
    If IsEmpty(MyCell.value) = False Then
        If ListOfInteger.ListContains(rows, MyCell.Row) = False Then
            ListAdd rows, MyCell.Row
        End If
    End If
Next
ListOfInteger.DebugOutputList rows

End Sub

如果您需要其他列表类型，只需复制模块，将其保存在例如ListOfLong 并将所有类型的 Integer 替换为 Long。就是这样:-)

Answer 5

我意识到这是一个老问题，但我使用了一种更简单的方法。通常我只是通过查询或复制现有列表或其他方式获取我需要的列表，然后删除重复项。根据原始问题，我们将假设您的列表已经在 C 列第 4 行中。此方法适用于您拥有的任何大小的列表，您可以选择标题是或否。

Dim rng as range
Range("C4").Select
Set rng = Range(Selection, Selection.End(xlDown))
rng.RemoveDuplicates Columns:=1, Header:=xlYes