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

时间:2014-03-17 16:44:15

标签: excel vba

    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中返回多个值。 我该怎么改变呢?

3 个答案:

答案 0 :(得分: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

答案 1 :(得分:0)

考虑:

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

答案 2 :(得分:0)

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