Excel中VBA相关函数的使用

自定义函数实例-单元颜色求和(字典+自定义函数)

Function COLORSUM(单元格区域 As range, 汇总的颜色 As range)
Set d = CreateObject("Scripting.Dictionary")
For Each Rng In 汇总的颜色
    d(Rng.Interior.ColorIndex) = ""
Next
For Each ci In d.keys
    For Each Rng In 单元格区域
        If Rng.Interior.ColorIndex = ci Then
            r = r + Rng.Value
        End If
    Next
    Next
COLORSUM = r
End Function

Sub test()
Set d = CreateObject("Scripting.Dictionary")
Set 区域 = Application.InputBox("区域选择", , , , , , , 8)
Set 颜色 = Application.InputBox("颜色选择", , , , , , , 8)
For Each Rng In 颜色
    d(Rng.Interior.ColorIndex) = ""
Next
For Each ci In d.keys
    For Each Rng In 区域
        If Rng.Interior.ColorIndex = ci Then
            r = r + Rng.Value
        End If
    Next
    Next
MsgBox r

End Sub

自定义函数实例-反转字符与数字求和（正则+自定义函数）

Function 求和(rng As Range, Optional s As String = "")
Application.Volatile
 Set regx = CreateObject("vbscript.regexp")
With regx
    .Global = True
    .Pattern = "\d" & s
   Set mat = .Execute(rng)
End With
For Each m In mat
n = n + m * 1
Next
求和 = n
End Function

Function DD(rng As Range) '反转字符
For i = Len(rng) To 1 Step -1
    a = Mid(rng, i, 1)
    b = b & a
Next
    DD = b
End Function

自定义函数实例-提取不重复值（字典+正则+自定义函数）

Function 不重复2(rng As Range, Optional num As Integer = 0)
Set d = CreateObject("scripting.dictionary")
Set regx = CreateObject("vbscript.regexp")
With regx
        .Global = True
    If num = 0 Then
        .Pattern = ".+" '所有值的不重复
    ElseIf num = 1 Then
        .Pattern = "[一-龢]+" '汉字不重复
    ElseIf num = 2 Then
        .Pattern = "[a-zA-Z]+" '字母不重复
    ElseIf num = 3 Then
        .Pattern = "\d+" '数字不重复
    End If
For Each rn In rng
    For Each m In .Execute(rn)
        d(m.Value) = ""
    Next
Next
不重复2 = d.keys
End With
End Function

Function 不重复值(rng As Range)
Set d = CreateObject("scripting.dictionary")
For Each rn In rng
    d(rn.Value) = ""
Next
不重复值 = d.keys
End Function