修改代码，使新代码的计算结果都比原来的小“1”

WYS67

上面截图里，C:D列是A列数据用自定义函数ZFCJS普通和区域数组公式得出的计算结果，现在需要：


全部保留自定义函数ZFCJS的计算功能和显示格式，只是让显示的结果比实际计算结果小“1”，如C5:D5，原来显示“9”，现在就像E列那样显示“8”。
代码如下：
Function ZFCJS(rgSource As Range) As Variant
    Dim arrSource As Variant, arrResult As Variant
    Dim lngRow As Long
    Dim strTemp As String, strChar As String
    Dim intLen As Integer
    Dim objDic As Object
   
    If rgSource.Count = 1 Then
        ReDim arrSource(1 To 1, 1 To 1)
        arrSource(1, 1) = rgSource
    Else
        arrSource = rgSource
    End If
   
    arrResult = arrSource
    Set objDic = CreateObject("Scripting.Dictionary")
   
    For lngRow = LBound(arrSource) To UBound(arrSource)
        strTemp = arrSource(lngRow, 1)
        strTemp = Trim(strTemp)
        objDic.RemoveAll
        For intLen = 1 To Len(strTemp)
            strChar = Mid(strTemp, intLen, 1)
            If Trim(strChar) <> "" Then objDic(strChar) = ""
        Next
        arrResult(lngRow, 1) = IIf(objDic.Count = 0, "", objDic.Count)
    Next
    Set objDic = Nothing
    ZFCJS = arrResult
End Function


我想应该是在上面的代码里，用各行不重复数据的总个数减去“1”就行了！唉，只能恨自己技术太菜，把上面的代码都揉搓烂了也没有得到想要的结果，只得恳请大神们帮忙了！


怎样让计算结果比原来少“1”.zip (430.56 KB, 下载次数: 5)

2019-1-10 20:19 上传

点击文件名下载附件

WYS67

恳请老师们指点一下，需要修改您解决代码，才能实现小“1”的结果？

liulang0808

ZFCJS = arrResult-1
没有看太懂，这样可行不？

WYS67

liulang0808 发表于 2019-1-10 22:03
ZFCJS = arrResult-1
没有看太懂，这样可行不？

不行啊！改成
ZFCJS = arrResult-1后，全部显示#VALUE!错误！

liulang0808

WYS67 发表于 2019-1-10 22:15
不行啊！改成
ZFCJS = arrResult-1后，全部显示#VALUE!错误！

    Set objDic = Nothing
    For lngRow = LBound(arrSource) To UBound(arrSource)
        arrResult(lngRow, 1) = arrResult(lngRow, 1) - 1
    Next
    ZFCJS = arrResult
增加红色这段呢？

WYS67

liulang0808 发表于 2019-1-10 22:23
Set objDic = Nothing
    For lngRow = LBound(arrSource) To UBound(arrSource)
        arrResu ...

版主老师：我再试试看。感谢老师！

WYS67

liulang0808 发表于 2019-1-10 22:23
Set objDic = Nothing
    For lngRow = LBound(arrSource) To UBound(arrSource)
        arrResu ...

老师：还是不行，遇到数据区域里出现空格时，就会全部显示#VALUE!错误！

liulang0808

WYS67 发表于 2019-1-10 22:56
老师：还是不行，遇到数据区域里出现空格时，就会全部显示#VALUE!错误！

rgSource 对这个参数增加判断，是否为空，然后决定返回值。
意见供参考。。。。。。

WYS67

liulang0808 发表于 2019-1-11 07:04
rgSource 对这个参数增加判断，是否为空，然后决定返回值。
意见供参考。。。。。。

老师：应该在哪两句之间增加判断？

liulang0808

WYS67 发表于 2019-1-11 07:54
老师：应该在哪两句之间增加判断？

1. 
   
2. Function ZFCJS(rgSource As Range) As Variant
   
3.     Dim arrSource As Variant, arrResult As Variant
   
4.     Dim lngRow As Long
   
5.     Dim strTemp As String, strChar As String
   
6.     Dim intLen As Integer
   
7.     Dim objDic As Object
   
8.    
   
9.     If rgSource.Count = 1 Then
   
10.         ReDim arrSource(1 To 1, 1 To 1)
    
11.         If Len(rgSource) = 0 Then
    
12.             ZFCJS = ""
    
13.             Exit Function
    
14.         Else
    
15.             arrSource(1, 1) = rgSource
    
16.         End If
    
17.     Else
    
18.         arrSource = rgSource
    
19.     End If
    
20.    
    
21.     arrResult = arrSource
    
22.     Set objDic = CreateObject("Scripting.Dictionary")
    
23.    
    
24.     For lngRow = LBound(arrSource) To UBound(arrSource)
    
25.         strTemp = arrSource(lngRow, 1)
    
26.         strTemp = Trim(strTemp)
    
27.         objDic.RemoveAll
    
28.         For intLen = 1 To Len(strTemp)
    
29.             strChar = Mid(strTemp, intLen, 1)
    
30.             If Trim(strChar) <> "" Then objDic(strChar) = ""
    
31.         Next
    
32.         arrResult(lngRow, 1) = IIf(objDic.Count = 0, "", objDic.Count - 1)
    
33.     Next
    
34.     Set objDic = Nothing
    
35.     ZFCJS = arrResult
    
36. End Function

复制代码