一个VBA自定义函数，使用文本格式连接唯一值单元格

excelperfect

标签：VBA实用代码

一个单元格区域内有一组数字，这些数字中存在多个相同的数字，想要将这些数字中的唯一值提取出来并组合成一串数字文本，如下图1所示。

图1

可以使用VBA编写自定义函数来实现，代码如下：

Function ConcatenateUnique(ByRef rngRange As Range, _

         Optional ByVal SeperatorAs String = ' ', _

         Optional ByVal Format AsString = '@', _

         Optional ByVal CaseSensitive As Boolean = False) _

         As String

    Dim rng As Range

    Dim strAnswer As String

    Dim strTemp As String

    Dim CompMethod As VbCompareMethod

    '为InStr函数设置文本比较模式

    If CaseSensitive Then

        CompMethod =vbBinaryCompare

    Else

        CompMethod = vbTextCompare

    End If

    For Each rng In rngRange

        strTemp = rng.Value

        '仅处理非空单元格

        If Not strTemp =vbNullString Then

            '应用格式

            strTemp =Application.WorksheetFunction.Text(strTemp, Format)

            '首先初始化结果字符串, 然后合并

            If strAnswer =vbNullString Then

                strAnswer = strTemp

            Else

                '仅合并唯一值

                If InStr(1,Seperator & strAnswer & Seperator, _

                        Seperator& strTemp & Seperator, CompMethod) = 0 Then

                    strAnswer =strAnswer & Seperator & strTemp

                End If

            End If

        End If

    Next rng

    '返回结果字符串

    ConcatenateUnique = strAnswer

End Function

这个函数仅将指定单元格区域中的唯一值使用可选的格式字符串连接起来。如果未指定格式字符串，则被视为字符串（@）。此函数在每个值之间插入分隔符字符串，默认分隔符设置为” ”。

这段代码来自strugglingtoexcel.com。通常，我们会考虑使用Dictionary对象，在连接符合要求的值之前获取唯一列表。然而，这段代码另辟蹊径，使用了VBA中的InStr函数，在连接之前检查是否已将值添加到结果中，如果没有则添加。巧妙的实现方法！

欢迎在下面留言，完善本文内容，让更多的人学到更完美的知识。

欢迎到知识星球：完美Excel社群，进行技术交流和提问，获取更多电子资料，并通过社群加入专门的微信讨论群，更方便交流。