同一单元格返回多个符合条件值的MLookup
Function MLookup(val, array1 As Range, array2 As Range, f As Byte) As String
'val 为要查找的值
'array1 要在其中查找的矩形区域,可单列(行) 或多行多列
'array2 是要返回相应值的与array1等大的矩形区域
'f 为0时精确查找,为1时模糊查找
Dim c As Range, FirstAddress As String
With array1
Set c = .Find(val, .Cells(.Count), xlValues, f + 1)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
MLookup = MLookup & "," & array2.Cells(c.Row - .Row + 1, c.Column - .Column + 1).Text
Set c = .Find(val, c, xlValues, f + 1)
Loop Until c.Address = FirstAddress
End If
MLookup = Mid(MLookup, 2)
End With
End Function

Public Function xiaoxie(cJine As String) '大写人民币转小写
Dim i As Byte, t$, n As Byte, w As Byte, f As Integer
i = 0
f = IIf(Left(cJine, 1) = "负", -1, 1)
Do While cJine <> ""
i = i + 1
t = Left(cJine, 1)
n = InStr("壹贰叁肆伍陆柒捌玖", t)
If n > 0 Then
w = InStr("分角元拾佰仟", Mid(cJine, 2, 1))
If w > 0 Then
xiaoxie = xiaoxie + n * 10 ^ (w - 3)
cJine = Mid(cJine, 3)
Else
xiaoxie = xiaoxie + n
cJine = Mid(cJine, 2)
End If
ElseIf InStr("亿万元", t) > 0 Then
xiaoxie = xiaoxie * 10 ^ IIf(Left(cJine, 1) = "元", 0, IIf(InStr(cJine, "万") = 0 And Left(cJine, 1) = "亿", 8, 4))
cJine = Mid(cJine, 2)
Else
cJine = Mid(cJine, 2)
End If
Loop
xiaoxie = xiaoxie * f
End Function

Function countv(x As Range, y As String, z) As Integer '可见单元格条件计数
Set x = Application.Intersect(x.Parent.UsedRange, x)
If Not IsNumeric(z) Then z = """" & z & """"
With x
For r = 1 To .Rows.Count
If Not .Rows(r).EntireRow.Hidden Then
For c = 1 To .Columns.Count
t = .Cells(r, c).value
If Not IsNumeric(t) Then t = """" & t & """"
If Application.Evaluate(t & y & z) Then countv = countv + 1
Next
End If
Next
End With
End Function