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

2022-03-04 16:14:53 浏览数 (1)

标签:VBA实用代码

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

图1

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

代码语言:javascript复制
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函数,在连接之前检查是否已将值添加到结果中,如果没有则添加。巧妙的实现方法!

0 人点赞