我正在尝试在列中创建一个唯一名称列表但我从未理解如何正确使用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
答案 0 :(得分:5)
您不需要数组。尝试类似:
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
答案 1 :(得分:4)
你可以尝试我的建议来解决道格的方法 但是如果你想坚持你的逻辑,你可以试试这个:
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
我没有时间检查时差。
所以我把测试留给你了。
答案 2 :(得分:1)
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
答案 3 :(得分:1)
受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。这就是它: - )
答案 4 :(得分:1)
我意识到这是一个老问题,但我使用了一种更简单的方法。通常我只是通过查询或复制现有列表等来获取我需要的列表,然后删除重复项。我们将根据原始问题假设您的列表已在C列第4行中。此方法适用于您拥有的任何大小列表,您可以选择标题是或否。
Dim rng as range
Range("C4").Select
Set rng = Range(Selection, Selection.End(xlDown))
rng.RemoveDuplicates Columns:=1, Header:=xlYes