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

因此，一旦它具有名称，一旦它将永远不会再在列表中再次弹出。

最后，数组应包含：

    Stack
    Overflow
    .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

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

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并用Long替换所有类型的Integer。这就是它： - ）

Answer 5

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

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

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

5 个答案: