|
本帖最后由 WYS67 于 2019-11-21 02:43 编辑
老师:下面这个自定义函数CHONGHAO,专门为三位数的数字而创建。但个别时候,会遇到数据区域【即第一参数】不是由三位数组成的情况,如 15,这时候的计算结果就会出现错误【无奈之下,我只能输入加上条件判断的公式 { =IF(LEN(Y5:Y4396)=3,CHONGHAO(Y5:Y4396,2,0),"") 】。
为此,有必要在代码中增加一句代码:当数据区域每个单元格必须是三位数时,才可显示计算结果;如果不等于三位数,则计算结果应该屏蔽为空白!!!
恳请老师在下面合适的地方加上这个条件判断语句。
Option Explicit
Function CHONGHAO(rgSource As Range, intType As Integer, Optional intDisplay As Integer = 0, Optional varNum As Variant = "") As Variant
Dim arrSource As Variant, arrResult As Variant, arrTemp As Variant, strNum As String
Dim lngRows As Long, lngR As Long, strCur As String, strFirst As String
Application.Volatile True
lngRows = rgSource.Rows.Count
strNum = Trim(varNum)
If IsArray(rgSource) And lngRows > 1 Then
arrSource = rgSource
Else
MsgBox "输入的数据源有误,请核对后重新输入!"
Exit Function
End If
ReDim arrResult(1 To lngRows, 1 To 3) As String
For lngR = LBound(arrSource) To UBound(arrSource)
strCur = Trim(arrSource(lngR, 1))
If lngR > LBound(arrSource) Then
If Trim(arrSource(lngR - 1, 1)) <> "" Then strFirst = Trim(arrSource(lngR - 1, 1))
End If
If strNum <> "" Then strFirst = strNum
If strCur <> "" And strFirst <> "" Then
arrTemp = CheckStr(strFirst, strCur, intType)
arrResult(lngR, 1) = arrTemp(1)
arrResult(lngR, 2) = arrTemp(2)
arrResult(lngR, 3) = arrTemp(3)
End If
Next
Select Case intDisplay
Case 0
arrTemp = Application.WorksheetFunction.Index(arrResult, 0, 3)
Case 1
arrTemp = Application.WorksheetFunction.Index(arrResult, 0, 1)
Case 2
arrTemp = Application.WorksheetFunction.Index(arrResult, 0, 2)
End Select
If intDisplay <> 0 Then
For lngR = LBound(arrTemp) To UBound(arrTemp)
If arrTemp(lngR, 1) <> "" Then arrTemp(lngR, 1) = Val(arrTemp(lngR, 1))
Next
End If
CHONGHAO = arrTemp
End Function
Private Function CheckStr(strA As String, strB As String, Optional intType As Integer = 1) As Variant
Dim lngID As Long, lngSum As Long
Dim strCount As Long, strAddRess As String
Dim strFind As String, strResult() As String
ReDim strResult(1 To 3) As String
If intType <> 1 Then intType = 2 '如果不是直选,设置为组选
For lngID = 1 To 3
Select Case intType
Case 1 '直选算法
lngSum = lngSum + Abs((Mid(strA, lngID, 1) = Mid(strB, lngID, 1)) * 1) * (2 ^ (lngID - 1))
Case 2 '组选算法
strFind = Mid(strA, lngID, 1)
lngSum = lngSum + Abs((InStr(strB, strFind) > 0) * 1) * (2 ^ (lngID - 1))
strB = Replace(strB, strFind, "-", 1, 1)
End Select
Next
Select Case lngSum
Case 0 '无重复
strCount = 0: strAddRess = 0
Case 1 '百位相同
strCount = 1: strAddRess = 1
Case 2 '十位相同
strCount = 1: strAddRess = 2
Case 3 '百位、十位相同
strCount = 2: strAddRess = 1
Case 4 '个位相同
strCount = 1: strAddRess = 3
Case 5 '百位、个位相同
strCount = 2: strAddRess = 3
Case 6 '十位、个位相同
strCount = 2: strAddRess = 2
Case 7 '三位都相同
strCount = 3: strAddRess = 4
End Select
strResult(1) = strCount
strResult(2) = strAddRess
strResult(3) = strCount & strAddRess
CheckStr = strResult
End Function
|
|