Question

有更快的方法吗？

Set data = ws.UsedRange

Set unique = CreateObject("Scripting.Dictionary")

On Error Resume Next
For x = 1 To data.Rows.Count
    unique.Add data(x, some_column_number).Value, 1
Next x
On Error GoTo 0

此时unique.keys得到了我需要的东西，但对于拥有成千上万条记录的文件来说，循环本身似乎非常慢（而这在一种语言中根本就不是问题特别喜欢Python或C ++。

Answer 1

使用Excel的AdvancedFilter函数执行此操作（使用Excel内置C ++是最快的方法）。

复制A列中的值并在B列中插入唯一值：

Range("A1:A6").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1"), Unique:=True

它也适用于多个列：

Range("A1:B4").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("D1:E1"), Unique:=True

Answer 2

在数组中加载值会快得多：

Dim data(), unique As Variant, r As Long
data = ws.UsedRange.Value

Set unique = CreateObject("Scripting.Dictionary")
For r = 1 To UBound(data)
    unique(data(r, some_column_number)) = Empty
Next r

您还应该考虑对Scripting.Dictionary进行早期绑定：

Dim unique As New Scripting.Dictionary

Answer 3

PowerShell是一款功能强大且高效的工具。这是作弊，但通过VBA炮轰PowerShell打开了很多选项

下面的大部分代码只是将当前工作表保存为 csv 文件。输出是另一个 csv 文件，只有唯一值

import Foundation

let input = "My name Swift is Taylor Swift "// the input string where we will find for the pattern
let nsString = input as NSString

let regex = try NSRegularExpression(pattern: "Swift|Taylor", options: NSRegularExpressionOptions.CaseInsensitive)
//matches will store the all range objects in form of NSTextCheckingResult 
let matches = regex.matchesInString(input, options: [], range: NSMakeRange(0, input.characters.count)) as Array<NSTextCheckingResult>

for match in matches {
    // what will be the code
    let range = match.range
    let matchString = nsString.substringWithRange(match.range) as String
    print("match is \(range) \(matchString)")
}

Answer 4

试试这个

Option Explicit

Sub UniqueValues()
Dim ws As Worksheet
Dim uniqueRng As Range
Dim myCol As Long

myCol = 5 '<== set it as per your needs
Set ws = ThisWorkbook.Worksheets("unique") '<== set it as per your needs

Set uniqueRng = GetUniqueValues(ws, myCol)

End Sub


Function GetUniqueValues(ws As Worksheet, col As Long) As Range
Dim firstRow As Long

With ws
    .Columns(col).RemoveDuplicates Columns:=Array(1), header:=xlNo

    firstRow = 1
    If IsEmpty(.Cells(1, col)) Then firstRow = .Cells(1, col).End(xlDown).row

    Set GetUniqueValues = Range(.Cells(firstRow, col), .Cells(.Rows.Count, col).End(xlUp))
End With

End Function

它应该非常快，没有NeepNeepNeep讲述的缺点

Answer 5

这很有趣，因为我不得不一遍又一遍地阅读这些说明，但它认为我找到了一种更快的方法来做到这一点：

Set data = ws.UsedRange
dim unique as variant
unique = WorksheetFunction.Unique(data)

然后你可以对 unique 数组做任何你想做的事情，比如迭代它：

For i = LBound(unique) To UBound(unique)
    Range("Q" & i) = indexes(i, 1)
Next

更快地获取VBA中列的所有唯一值？

5 个答案: