发送一个范围到一个函数

enter code here我无法发送范围到一个函数，似乎它发送一个空的范围，但我知道它不是。

这就是我所说的function：

 Dim rCellRange As Excel.Range Dim nOfWords As Integer Dim MyVal As String findWordsResult = FindWords(rCellRange, nOfWords, MyVal) 

其中rCellRange是一个特定的单元格，假设$ A $ 1，nOfWords是一个整数，MyVal是要查找单词的string。

这是function：

 Function FindWords(cellToSearch As Range, nOfWords As Integer, ParamArray words() As Variant) As Long Dim counter As Long Dim arr arr = Split(cellToSearch) Dim word, element If UBound(arr) > 0 Then For Each word In words For Each element In arr If word = element Then counter = counter + 1 Next Next Else ' cell to search is empty counter = 0 End If If counter = nOfWords Then FindWords = 1 Else FindWords = 0 End If End Function 

它总是返回FindWords = 0，即使我知道它应该是1.我检查了传入参数和nOfWords和MyVal正确传输，但rCellRange似乎是空的。

哪里有问题？

编辑：也许我应该粘贴完整的代码，而不是它的一部分。 我知道有很多丑陋的解决scheme，但我不是专家，所以…这是完整的代码：

  Sub Set_Hyper() ' Object variables Dim wks As Excel.Worksheet Dim rCell As Excel.Range, testRange As Excel.Range, rCellRange As Excel.Range Dim fFirst As String, splitSearch As String, MyVal As String Dim nOfWords As Integer, findWordsResult As Integer, oneWord As Integer Dim i As Long ' Sätt det inmatade ordet som sökord MyVal = ActiveSheet.Range("D9") Set testRange = ActiveSheet.Range("D9") ' Ränka antalet inskrivna ord och dela upp söksträngen i flera ord nOfWords = COUNTWORDS(testRange) If nOfWords > 1 Then splitSearch = Split(MyVal)(0) Else splitSearch = MyVal End If Application.ScreenUpdating = False Application.DisplayAlerts = False ' Rensa resultatlistan från förra sökningen Application.Volatile (False) Worksheets("Start").Range("D19:H99").Clear ' Sätt vit bakgrund på sökresultatet Range("D19:H99").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorDark1 .TintAndShade = 0 .PatternTintAndShade = 0 End With i = 19 ' Begin looping: For Each wks In ActiveWorkbook.Worksheets If wks.Name <> "Start" Then With wks.Range("A:E") Set rCell = .Find(splitSearch, , , xlPart, xlByColumns, xlNext, False) ' If something is found keep going If Not rCell Is Nothing Then ' Store the first address fFirst = rCell.Address Set rCellRange = Range(rCell.Address) If nOfWords > 1 Then findWordsResult = FindWords(rCellRange, nOfWords, MyVal) Else End If ' Ta reda på i vilken kolumn resultetet finns i och visa resultatet If findWordsResult = 1 Or nOfWords = 1 Then Do If rCell.Column() = 1 Then ' Link to each cell with an occurence of {MyVal} rCell.Hyperlinks.Add Cells(i, 4), "", "'" & wks.Name & "'!" & rCell.Address, TextToDisplay:=rCell.Value rCell.Offset(0, 1).Copy Destination:=Cells(i, 5) rCell.Offset(0, 2).Copy Destination:=Cells(i, 6) rCell.Offset(0, 3).Copy Destination:=Cells(i, 7) rCell.Offset(0, 4).Copy Destination:=Cells(i, 8) Set rCell = .FindNext(rCell) i = i + 1 'Increment our counter End If If rCell.Column() = 2 Then ' Link to each cell with an occurence of {MyVal} rCell.Hyperlinks.Add Cells(i, 4), "", "'" & wks.Name & "'!" & rCell.Address, TextToDisplay:=rCell.Offset(0, -1).Value rCell.Copy Destination:=Cells(i, 5) rCell.Offset(0, 1).Copy Destination:=Cells(i, 6) rCell.Offset(0, 2).Copy Destination:=Cells(i, 7) rCell.Offset(0, 3).Copy Destination:=Cells(i, 8) Set rCell = .FindNext(rCell) i = i + 1 'Increment our counter End If If rCell.Column() = 3 Then ' Link to each cell with an occurence of {MyVal} rCell.Hyperlinks.Add Cells(i, 4), "", "'" & wks.Name & "'!" & rCell.Address, TextToDisplay:=rCell.Offset(0, -2).Value rCell.Offset(0, -1).Copy Destination:=Cells(i, 5) rCell.Copy Destination:=Cells(i, 6) rCell.Offset(0, 1).Copy Destination:=Cells(i, 7) rCell.Offset(0, 2).Copy Destination:=Cells(i, 8) Set rCell = .FindNext(rCell) i = i + 1 'Increment our counter End If If rCell.Column() = 4 Then ' Link to each cell with an occurence of {MyVal} rCell.Hyperlinks.Add Cells(i, 4), "", "'" & wks.Name & "'!" & rCell.Address, TextToDisplay:=rCell.Offset(0, -3).Value rCell.Offset(0, -2).Copy Destination:=Cells(i, 5) rCell.Offset(0, -1).Copy Destination:=Cells(i, 6) rCell.Copy Destination:=Cells(i, 7) rCell.Offset(0, 1).Copy Destination:=Cells(i, 8) Set rCell = .FindNext(rCell) i = i + 1 'Increment our counter End If If rCell.Column() = 5 Then ' Link to each cell with an occurence of {MyVal} rCell.Hyperlinks.Add Cells(i, 4), "", "'" & wks.Name & "'!" & rCell.Address, TextToDisplay:=rCell.Offset(0, -4).Value rCell.Offset(0, -3).Copy Destination:=Cells(i, 5) rCell.Offset(0, -2).Copy Destination:=Cells(i, 6) rCell.Offset(0, -1).Copy Destination:=Cells(i, 7) rCell.Copy Destination:=Cells(i, 8) Set rCell = .FindNext(rCell) i = i + 1 'Increment our counter End If ' Test att skapa vit bakgrund With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorDark1 .TintAndShade = 0 .PatternTintAndShade = 0 End With Loop While Not rCell Is Nothing And rCell.Address <> fFirst Else End If End If End With End If Next wks ' Explicitly clear memory Set rCell = Nothing ' If no matches were found, let the user know If i = 18 Then MsgBox "The value {" & MyVal & "} was not found on any sheet", 64, "No Matches" Cells(1, 1).Value = "" End If ' Reset application settings Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub 

这里是COUNTWORDS函数：

 Function COUNTWORDS(rRange As Range) As Long Dim rCell As Range Dim Count As Long For Each rCell In rRange lCount = lCount + Len(Trim(rCell)) - Len(Replace(Trim(rCell), " ", "")) + 1 Next rCell COUNTWORDS = lCount 

结束function

Answer 1

试试这似乎对我有用。

 Option Explicit Function FindWords(cellToSearch As Range, ParamArray words() As Variant) As Long Dim counter As Long Dim arr As Variant If Not IsEmpty(cellToSearch) Then arr = Split(cellToSearch) Else FindWords = 0 Exit Function End If Dim word As Variant For Each word In words If Not IsError(Application.Match(word, arr, 0)) Then counter = counter + 1 End If Next FindWords = counter End Function 

在工作表中的结果：
单词search

2字search

结果在VBA中：

 Sub test() Dim i As Long Dim myval myval = Array("Foo", "bar") i = FindWords(Range("A1"), myval(0), myval(1)) 'i = FindWords(Range("A1"), "Foo", "bar") Debug.Print i '~~> this returns 2 for both line code above End Sub 

请记住，当您使用ParamArray时 ，您需要指定您想要在数组中传递的每个元素。
如果这与你想要的有所不同，那就更新你的问题。 HTH

Answer 2

你的function工作正常，但

1. 被调用时，您不提供任何有效的范围。

2. 可能是您search的CASE与Excel中实际存在的不同

查看我的编辑：

 Public Sub test() Dim rCellRange As Excel.Range Dim nOfWords As Integer Dim MyVal As String 'BEFORE RUNNING THIS, please put "The Big Blue Fox Flew over the cuccoo nest" in to the cell A1 Set rCellRange = ThisWorkbook.Worksheets(1).Range("A1") nOfWords = 1 MyVal = "Fox" findWordsResult = FindWords(rCellRange, nOfWords, MyVal) MsgBox findWordsResult End Sub Function FindWords(cellToSearch As Range, nOfWords As Integer, ParamArray words() As Variant) As Long Dim counter As Long Dim arr arr = Split(cellToSearch) Dim word, element If UBound(arr) > 0 Then For Each word In words For Each element In arr 'If you want to make this case insensitive, use: If UCase(word) = UCase(element) Then counter = counter + 1 If word = element Then counter = counter + 1 Next Next Else ' cell to search is empty counter = 0 End If If counter = nOfWords Then FindWords = 1 Else FindWords = 0 End If End Function