Question

您好，并提前感谢您。

说实话，我不知道在这种情况下出了什么问题。我曾经多次使用过这个功能，效果很好;但是，这次它会抛出一个错误。

Function CountUnique(ByVal Rng As Range) As Long
  Dim St As String
  Set Rng = Intersect(Rng, Rng.Parent.UsedRange)
  St = "'" & Rng.Parent.Name & "'!" & Rng.Address(False, False)
  CountUnique = Evaluate("SUM(IF(LEN(" & St & "),1/COUNTIF(" & St & "," & St & ")))") 'ERROR HERE
End Function

错误发生在我返回结果的最后一行。我在我的代码中使用了这个函数，并弹出了同样的错误。我扫描了代码，似乎没有任何错误，所以我按下继续调试，它经历了（字面上没有改变）。

编辑1：我以这种方式使用它：

lTotal = CountUnique(wSht.UsedRange.Columns(1))

我正在尝试计算该列中的唯一编号。

Answer 1

最后，最终使用了不同的功能。无论我改变什么，我都无法找到问题所在。这是我使用的那个：

Public Function CntUnique(rng As Range)
Dim Uni As Collection, cl As Range, LpRange As Range
Dim clswfrm As Range, clswcst As Range, myRng As Range
Dim TotUni As Long
'*************
Set myRng = rng 'define your sheet/range
'*************
On Error Resume Next
Set clswfrm = myRng.SpecialCells(xlFormulas)
Set clswcst = myRng.SpecialCells(xlConstants)
Set myRng = Nothing 'free up memory
On Error GoTo 0
If clswfrm Is Nothing And clswcst Is Nothing Then
    MsgBox "No Unique Cells"
    Exit Function
    ElseIf Not clswfrm Is Nothing And Not clswcst Is Nothing Then
        Set LpRange = Union(clswcst, clswfrm)
    ElseIf clswfrm Is Nothing Then Set LpRange = clswcst
    Else: Set LpRange = clswfrm
End If
Set clswfrm = Nothing: Set clswcst = Nothing 'Free up memory
Set Uni = New Collection
On Error Resume Next
For Each cl In LpRange
    Uni.Add cl.Value, CStr(cl.Value) 'assign unique key string
Next cl
On Error GoTo 0
Set LpRange = Nothing 'free up memory
TotUni = Uni.Count
Set Uni = Nothing ''free up memory
CntUnique = TotUni 'Work with the Unique value total here (replace msgbox)
End Function

找不到具有指定名称的项目

1 个答案: