excelperfect

標(biāo)簽：VBA實(shí)用代碼

一個(gè)單元格區(qū)域內(nèi)有一組數(shù)字，這些數(shù)字中存在多個(gè)相同的數(shù)字，想要將這些數(shù)字中的唯一值提取出來(lái)并組合成一串?dāng)?shù)字文本，如下圖1所示。

圖1

可以使用VBA編寫(xiě)自定義函數(shù)來(lái)實(shí)現(xiàn)，代碼如下：

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函數(shù)設(shè)置文本比較模式

    If CaseSensitive Then

        CompMethod =vbBinaryCompare

    Else

        CompMethod = vbTextCompare

    End If

    For Each rng In rngRange

        strTemp = rng.Value

        '僅處理非空單元格

        If Not strTemp =vbNullString Then

            '應(yīng)用格式

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

            '首先初始化結(jié)果字符串, 然后合并

            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

    '返回結(jié)果字符串

    ConcatenateUnique = strAnswer

End Function

這個(gè)函數(shù)僅將指定單元格區(qū)域中的唯一值使用可選的格式字符串連接起來(lái)。如果未指定格式字符串，則被視為字符串（@）。此函數(shù)在每個(gè)值之間插入分隔符字符串，默認(rèn)分隔符設(shè)置為” ”。

這段代碼來(lái)自strugglingtoexcel.com。通常，我們會(huì)考慮使用Dictionary對(duì)象，在連接符合要求的值之前獲取唯一列表。然而，這段代碼另辟蹊徑，使用了VBA中的InStr函數(shù)，在連接之前檢查是否已將值添加到結(jié)果中，如果沒(méi)有則添加。巧妙的實(shí)現(xiàn)方法！

歡迎到知識(shí)星球：完美Excel社群，進(jìn)行技術(shù)交流和提問(wèn)，獲取更多電子資料，并通過(guò)社群加入專門(mén)的微信討論群，更方便交流。