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