Function Excel 2010:VBA将自定义函数代码转换为具有宏快捷方式的模块

信息：Excel 2010
注意：这段代码正是我所需要的，我现在想让它自动化一点

我最近遇到了这段代码，它是一个自定义函数，但我不能为它创建一个按钮（如宏），我想转换一些这段代码，但我不知道做什么或如何去做。我想在功能区上有一个快捷键/按钮

函数列表唯一（rng作为范围）作为变量
暗行作为范围
将元素（）设置为字符串
Dim elementSize为整数
将新元素设置为布尔值
作为整数的Dim i
将距离变为整数
将结果变暗为字符串
elementSize=0
newElement=True
对于rng.行中的每一行
如果row.Value为“”，则
newElement=True
对于i=1到elementSize步骤1
如果元素（i-1）=行值，则
newElement=False
如果结束
接下来我
如果是新元素那么
elementSize=elementSize+1
ReDim保留元素（elementSize-1）
元素（elementSize-1）=行值
如果结束
如果结束
下一个
距离=范围（Application.Caller.Address）.row-rng.row
如果距离<元素大小，则
结果=元素（距离）
listUnique=结果
其他的
listUnique=“”
如果结束
端函数

具有以下能力的结果：

只需输入单元格的=listUnique（范围）。唯一的参数是范围 这是一个普通的Excel范围。例如：A$1:A$28或H$8:H$30

我想要以下内容： 创建一个带有弹出窗口的宏按钮

Inputbox

，以询问范围

用法：

1） 我在需要列表开始的单元格中（BA9）
2） 我单击自定义模块/宏按钮，弹出框询问范围（G$8:G$10000）
3） 然后，结果将自动填入列（BA）

最后，是否可以修改代码，以便删除“调用函数的第一个单元格必须位于范围开始的同一行”的限制，以便我可以使用同一工作簿中其他工作表中的引用

如果我应该直接去找编码员，我道歉，因为它所在的线程是旧的&我认为考虑到我要求的更改量，它可能更适合自己的问题

---

提前感谢您。

第一种方法：（您可以使用

移除的副本

方法代替函数

列表唯一

）

只需将此

Sub

分配给您的自定义按钮：

Sub testRemoveDuplicates()
    Dim targetRange As Range
    Dim actCell As Range
    Dim res As Variant

    Set actCell = ActiveCell

    On Error Resume Next
    Set targetRange = Application.InputBox("Please highlight the cell for TARGET", Type:=8)
    On Error GoTo 0

    If targetRange Is Nothing Then
       MsgBox "User has pressed cancel"
       Exit Sub
    End If

    targetRange.Copy
    actCell.PasteSpecial xlPasteValues
    actCell.RemoveDuplicates Columns:=1, Header:=xlNo

    Application.CutCopyMode = False
End Sub

Sub test()
    Dim targetRange As Range
    Dim actCell As Range
    Dim res As Variant

    Set actCell = ActiveCell

    On Error Resume Next
    Set targetRange = Application.InputBox("Please highlight the cell for TARGET", Type:=8)
    On Error GoTo 0

    If targetRange Is Nothing Then
       MsgBox "User has pressed cancel"
       Exit Sub
    End If

    res = listUnique(targetRange)

    actCell.Resize(UBound(res)) = res
End Sub

---

第二种方法：（如果您想使用函数

listUnique

）

下面是另一个

listUnique

函数。您可以使用gn对象获取唯一元素的列表（它更适合您的用途）：

---

注意：如果要直接从工作表调用此

listUnique

函数（作为UDF函数），则应选择目标范围（在示例

D10:D20

中），将选定范围输入公式栏中的公式

=listUnique（A1:A10）

，然后按CTRL+SHIFT+enter对其求值

谢谢你的回答，我会运行它们并发回，现在是凌晨3点：）到目前为止看起来不错，谢谢。只要运行这两个选项，我可以让选项1工作，但不是选项2。选项2为我提供了一列空白或0。但是选项1是完美的！谢谢：DSorry，我的错..我已经用新的

listUnique

function:）更新了我的asnwer-我现在可以让它工作了，唯一的问题是日期为yyyy-mmm-dd-mm-yyyyy（正确：2014-1-04，错误：（2014年1月4日）2014年4月1日）。我试图覆盖格式，但它恶化了。但在纯文本上，这很好：DText到列修复了这个问题

Function listUnique(rng As Range) As Variant
    Dim row As Range
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    On Error Resume Next

    For Each row In rng.Rows
        If row.Value <> "" Then
            dict.Add row.Value, row.Value
        End If
    Next

    Dim res As Variant
    ReDim res(1 To dict.Count)

    res = dict.Items

    Set dict = Nothing
    listUnique = Application.Transpose(res)
End Function

Sub test()
    Dim targetRange As Range
    Dim actCell As Range
    Dim res As Variant

    Set actCell = ActiveCell

    On Error Resume Next
    Set targetRange = Application.InputBox("Please highlight the cell for TARGET", Type:=8)
    On Error GoTo 0

    If targetRange Is Nothing Then
       MsgBox "User has pressed cancel"
       Exit Sub
    End If

    res = listUnique(targetRange)

    actCell.Resize(UBound(res)) = res
End Sub