使用VBA在excel中的不同单元格中返回多个值

Question

    Function toto() As Variant

    For Each cell In Range("N1:N45")
        found = 0
        For Each cell2 In Range("B:B")
            If cell.Value = cell2.Value Then
                found = 1
            End If
            If found = 1 Then
                toto = cell.Value
                Exit For
            End If
        Next
     Next    
End Function

我想在Excel中返回多个值。 我应该如何改变呢？

Answer 1

一种方法是使用全局变量来计算找到的匹配数。 在代码顶部声明此变量，并按如下所示修改函数：

Dim found As Integer

Function toto() As Variant
    Dim count As Integer
    count = 0

    For Each cell In Range("N1:N45")
        For Each cell2 In Range("B:B")
            If cell.Value = cell2.Value Then
                count = count + 1

                'Skip over previously returned values
                If count > found Then
                    found = found + 1
                    toto = cell.Value
                    Exit Function
                End If
            End If
        Next
     Next
End Function

---

即使不使用该函数，全局变量也将保留其值。 这意味着，每次调用toto()函数时，它将跳过先前找到的值。 这也意味着如果要重新开始，则必须重新设置。

这是一个测试子。 第一个电话将找到第一个比赛。 第二个呼叫将找到第二个匹配项，因为在两次呼叫之间我们没有将found重置为零。

Sub test()
    'Reset function
    found = 0
    MsgBox (toto())

    MsgBox (toto())
End Sub

Answer 2

考虑：

Function toto() As Variant
    For Each cell In Range("N1:N45")
        found = 0
        For Each cell2 In Intersect(ActiveSheet.UsedRange, Range("B:B"))
            If cell.Value = cell2.Value Then
                found = 1
            End If
            If found = 1 Then
                toto = toto & ", " & cell.Value
                found = 0
            End If
        Next
     Next
End Function

Answer 3

Function foo()
        y = 3
        For Each cell In Range("B2:B64")
            found = 0
            For Each cell2 In Intersect(ActiveSheet.UsedRange, Range("A:A"))
                If cell.Value = cell2.Value Then
                    found = 1
                    Exit For
                End If
            Next
            If found = 0 Then
                y = y + 1
                Cells(y, "D").Value = cell.Value
            End If
         Next   
End Function

然后有一个Sub函数来调用foo

Sub foo2()
    Range("D4:D80").ClearContents
    toto
End Sub