从“立即”窗口与从工作表内运行时，Excel vba 函数给出不同的结果答案

【问题标题】：Excel vba function giving different results when ran from "Immediate" window versus from within worksheet从“立即”窗口与从工作表内运行时，Excel vba 函数给出不同的结果
【发布时间】：2017-09-22 01:22:39
【问题描述】：

我在这里摸不着头脑，真的希望有人能指出我正确的方向。

我正在尝试创建一个 VBA 函数来计算某个范围内文本的唯一出现次数，并使用网上找到的代码变体来实现这一点。

基本上代码（如下）执行以下操作：

创建临时工作簿
将删除重复的文本列表复制到该工作簿中
计算等于多少行。

这是我目前的代码：

Public Function TestingMe() As Long
Dim numrows As Long
Dim rng As Range
Dim tempwb As Workbook, origwb As Workbook

Set origwb = ActiveWorkbook
Set tempwb = Workbooks.Add

Set rng = tempwb.Sheets(1).Range("A1")

origwb.Worksheets("data").Range("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=rng, Unique:=True

numrows = tempwb.Application.WorksheetFunction.CountA(tempwb.Sheets(1).Range("A:A").EntireColumn)
tempwb.Close (False)
Set origwb = Nothing
Set tempwb = Nothing

Debug.Print (numrows)
TestingMe = numrows
End Function

通过代码编辑器的“即时”窗口运行时，代码运行良好，但当用作工作表中的函数时，“COUNTA”函数正在查看 origwb 的第一张工作表，而不是临时工作簿所在的位置重复数据已复制到。

这似乎是一个参考/范围问题，但正如您所见，我已尝试在代码中专门引用所有内容以尝试解决该问题，但没有任何乐趣。

任何指针都将不胜感激。

提前致谢马丁

【问题讨论】：

接受的答案中的代码对您有帮助吗？ stackoverflow.com/questions/1676068/… 或者您应该将 Set rng = tempwb.Sheets(1).Range("A1") 更改为 Set rng = tempwb.Sheets(1).Range("A:A")？
从单元格调用的 UDF 无法添加新工作簿，也无法执行高级过滤。
@Rory - 混蛋，谢谢。看来我需要尝试另一种方法。
@RCaetano - 它有帮助，但不幸的是，它在处理更大的数据集时速度非常慢，所以如果可能的话，我正在寻找一种更快的机制
你只是在设置一个范围，据我所知，即使使用更大的数据集也不应该花这么长时间:)

标签： vba excel

【解决方案1】：

从您的解释看来，当从工作表 COUNTA 运行时，origwb 引用了错误的工作簿。试试下面的代码。将“ActualWorkbookname”替换为您要称为 origwb 的工作簿的名称。确保此工作簿已打开。

Workbooks("ActualWorkbookname.XLSX").Activate
Set origwb = ActiveWorkbook

【讨论】：

恐怕也行不通 - 如前所述，似乎无法从名为 UDF 的工作表创建新工作簿
正在 VBA 函数中调用 COUNTA 以计算临时工作簿上（未成功）复制的高级过滤器数据的结果

【解决方案2】：

问题是由于您在为唯一值应用过滤器时应该考虑为标题添加额外的顶行。如果您在tempwb.Close (False) 之前添加MsgBox "stop"，您将发现origwb 中的值没有被正确过滤，如下例所示：

最初在 origwb:

你会进入 tempwb:

请注意，第一个 1 未被考虑，因此它也出现在最后一行，导致 Application.WorksheetFunction.CountA 中的值不正确。

解决方案：

在过滤之前使origwb 的单元格A1 行没有相关数据，以充当na 标题，如“temp”。
在numrows = tempwb.Application.WorksheetFunction.CountA(tempwb.Sheets(1).Range("A:A").EntireColumn) - 1 中从numrows 中减去1

【讨论】：

问题是从工作表调用的 UDF 似乎不允许创建新工作簿（根据上面 Rory 的评论）。我已经通过单步执行 UDF 并遍历 Workbooks 集合“证明”了这一点，并且 tempwb 工作簿不存在。我还确认 AdvancedFilter 选项似乎不能从 UDF 中使用，因为我更改了代码以将工作表添加到现有工作簿（而不是创建新的 wb）并尝试在该工作表上使用高级过滤器没有喜悦。

【解决方案3】：

你可以试试这个解决方法

将您的函数折叠到：

Function TestingMe() As Long
    TestingMe = -9999
End Function

在任何模块中添加此代码

Sub DoWorkForTestingMe(Target As Range)
    Dim numrows As Long
    Dim rng As Range
    Dim tempwb As Workbook, origwb As Workbook

    Set origwb = ActiveWorkbook
    Set tempwb = Workbooks.Add

    Set rng = tempwb.Sheets(1).Range("A1")

    origwb.Worksheets("data").Range("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=rng, Unique:=True

    numrows = tempwb.Application.WorksheetFunction.CountA(tempwb.Sheets(1).Range("A:A").EntireColumn)
    tempwb.Close (False)
    Set origwb = Nothing
    Set tempwb = Nothing
    Target.Value = numrows
End Sub

在要在其中使用该功能的工作表的代码窗格中添加以下代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Value <> -9999 Then Exit Sub
    Application.EnableEvents = False
    On Error GoTo ExitSub
    DoWorkForTestingMe Target
ExitSub:
    Application.EnableEvents = True
End Sub

【讨论】：

除了您最初输入公式时，公式计算不会触发Change 事件。此外，您的公式永远不会重新计算。
@Rory，它确实在我测试时触发。至于重新计算，我知道，但我知道 OP 不需要这样做
它仅在您第一次输入公式时触发。我看不出这有什么帮助。如果需要静态结果，则根本不需要函数。
@Rory，它的帮助仅在于它显示了一种让函数添加工作簿和自动过滤工作表的方法。只是好玩...

【解决方案4】：

此代码使用集合和用户定义函数：

Function countUnique(r As range) As Long
    'Application.Volatile False ' optional
    Set r = Intersect(r, r.Worksheet.UsedRange) ' optional
    Dim c As New Collection, v
    On Error Resume Next ' to ignore the Run-time error 457: "This key is already associated with an element of this collection".
    For Each v In r.Value ' remove .Value for ranges with more than one Areas
        c.Add 0, v & ""
    Next
    c.Remove "" ' optional to exclude blanks from the count
    countUnique = c.Count
End Function

【讨论】：