范围中唯一值的数组-没有任何循环 [英] Array of unique values from range - Without any loop

问题描述

冒着成为主题的风险，我决定分享一些代码，问答式。如果普遍的看法是这样，我将很乐意将其删除。

At risk of being of topic, I decided to share some code, Q&A-style. If the general opinion is such that this would be off-topic I'll be happy to delete if need be.

_背景

范围为 持有一定数量值的对象，我想将这些值拉到数组中。传统的方式（至少对我而言）是使用 scripting.dictionary ，遍历 Range ，或者说是内存中的 Array ，将这些值添加到唯一列表中。

Having a Range object holding a certain amount of values I would want to pull those values into an array. The conventional way (at least to me) would be to use ""scripting.dictionary", loop through a Range, or rather an Array in memory, to add these values into a uniques list.

想看看是否有一种方法可以拉出不重复的唯一项数组。

While that works, I wanted to see if there is a method to pull an array of unique items without any loop.

_样本

想象一下 A1：A8 ：

Vals
A
B
A
B
C
C
B

---

_问题

检索唯一项的一维数组 {A，B，C} ，我们将如何进行无循环操作？

To retrieve a 1D-array of unique items {A,B,C}, how would we go about doing this without a loop?

推荐答案

_{Uniques-字典}

一个非常牢固的（和快速）返回唯一值的一维数组的方法是使用修道院ional Dictionary 对象如下：

A very solid (and fast) way of returning a 1D-array of unique values would be to use a conventional Dictionary object as below:

Sub UniquesDictionary()

Dim lr As Long, x As Long
Dim arr As Variant
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")

With Sheet1

    'Find the last used row
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("A2:A" & lr).Value

End With

    'Loop through memory and fill dictionary
    For x = LBound(arr) To UBound(arr)
        dict(arr(x, 1)) = 1
    Next x

    'Pull unique items into a 1D-array
    arr = dict.Keys

End Sub

---

_{Uniques-评估}

上述方法有效。希望避免任何循环。这样做的方法是使用 .Evaluate ，如下所示：

Whilst the above works. The wish was to avoid any loop. The way to do this is to use .Evaluate, see below:

Sub UniquesEvaluate()

Dim lr As Long
Dim arr As Variant

With Sheet1

    'Find the last used row
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row

    'Get array of unique values
    arr = Filter(.Evaluate("TRANSPOSE(If(Row(A2:A" & lr & ")<>MATCH(A2:A" & lr & ",A2:A" & lr & ",0)+1,""|"",A2:A" & lr & "))"), "|", False)

End With

End Sub

这似乎是一个很长的公式，但实际上并没有那么令人印象深刻，可以归结为：

It might seem like a long formula but it really isn't that impressive and boils down to:

=IF(ROW(A2:A8)<>MATCH(A2:A8,A2:A8,0)+1,"|",A2:A8)

TRANSPOSE 仅在其中返回一维数组过滤器可以使用。

The TRANSPOSE is only there to return a 1D-array for FILTER to work with.

• 初始公式仅返回那些通过 MATCH首次遇到的值。 code>，否则将返回管道符号。

• The inital formula will only return those values that are sitting on the rows where they are first encountered through MATCH, otherwise it would return a pipe-symbol.

因此， TRANSPOSE（< formula>）返回一维数组，例如： {A，B，|，|，C，|，|}

Thus TRANSPOSE(<formula>) returns a 1D-array, e.g.: {A,B,|,|,C,|,|}

_比较

只有当此方法与常规的<$ c一样快时，此方法才有意义。 $ c> Dictionary ，所以我做了一个小的比较。就我的测试而言，确实没有明显的时间差异（大约0秒），但是从本质上来说， Evaluate 是 CSE 公式，较大的数据集将获得明显的时序差异，比方说2000行数据。

This would only have real purpose if this method would be equally as fast as the more conventional Dictionary so I did a small comparison. As far as my testing goes, there was no really noticable timing difference (around 0 seconds), but since in essence the Evaluate is a CSE formula, larger datasets will get noticable timing differences above let's say 2000 rows of data.

希望这对处理较小数据集的用户有用。

Hopefully this is usefull to those working with smaller datasets.

这篇关于范围中唯一值的数组-没有任何循环的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！