时间戳

首页 > 解决方案 > 有没有一种方法可以构建有效的 vba 函数，它将一个范围作为其参数并返回一个唯一值数组（从重复中释放）？

arrays - 有没有一种方法可以构建有效的 vba 函数，它将一个范围作为其参数并返回一个唯一值数组（从重复中释放）？

问题描述

我想创建一个 vba 函数（公共函数），给定一个 1 列范围，它将返回其唯一值的数组。它必须完成与 RemoveDuplicates 方法相同的工作，但无需更改任何内容，它应该只返回一个唯一值数组。

我写了这段代码

Public varData() As Variant

Public Sub Suplem(rng As Range)

Dim tempSheet As Worksheet
Size = rng.Rows.Count
On Error GoTo tuda1
    Worksheets.Add.Name = "temp"
tuda1:
    Set tempSheet = ActiveWorkbook.Worksheets("temp")
With tempSheet
    tempSheet.Range(tempSheet.Cells(1, 1), tempSheet.Cells(Size, 1)).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
    tempSheet.Range(tempSheet.Cells(1, 1), tempSheet.Cells(Size, 1)).RemoveDuplicates
    varData = tempSheet.Range(tempSheet.Cells(1, 1), tempSheet.Cells(Size, 1)).Value
End With
tempSheet.Delete

End Sub


Public Function UniqueVals(rng As Range)

ReDim varData(rng.Rows.Count - 1)
Call Suplem(rng)
Dim a() As Variant
UniqueVals = varData
Erase varData

End Function

UniqueVals 函数在这里调用创建临时工作表的 Sub Suplem，将初始范围的副本粘贴到其中并从中删除重复项。然后它将从重复中释放的最终范围记录到全局数组 varData。之后 UniqueVals 函数返回 varData 中的数据并将其清除。

问题是这个函数返回#VALUE！因为在 Sub 中创建和修改的临时工作表。关于如何避免此错误的任何想法？我可以使用数组来代替，但以范围方式，即通过公式修改它吗？

标签： arraysvbafunction

解决方案

如果没有动态数组公式UNIQUE()，则使用使用字典的此函数。

Public Function UniqueVals(rng As Range) As Variant
    Dim rngArray As Variant
    rngArray = Intersect(rng, rng.Parent.UsedRange).Value

    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    Dim t As Variant
    For Each t In rngArray
        On Error Resume Next
            dict.Add t, t
        On Error GoTo 0
    Next t

    Dim temp() As Variant
    ReDim temp(1 To dict.Count, 1 To 1)

    Dim x As Long
    x = 1
    Dim key As Variant
    For Each key In dict.Keys
        temp(x, 1) = key
        x = x + 1
    Next key

    UniqueVals = temp
End Function

推荐阅读