在excel vba中自定義函數查找返回多個匹配值並將它們合併到一個單元格中的單元格值

Question

我想在excel vba中編寫一個自定義函數，該函數在返回多個範圍的單元格中查找單元格值匹配值並將它們合併到一個單元格中。 它返回一個錯誤值＃VALUE。

我想讓用戶使用這個功能，因爲寫一個子來做的工作正常。

Function LookUpMoreThanOneResult(LookUpFor As Range, LookUpAt As Range, col As Integer) As Range 


Dim Findings As Range 


For Each LookUpFor In LookUpFor.Cells 

     For Each LookUpAt In LookUpAt.Cells 

      If LookUpFor.Value = LookUpAt.Value Then 

      Findings.Value = Findings.Value & vbCrLf & LookUpAt.Offset(0, col).Value 
      End If 


     Next LookUpAt 

    Next LookUpFor 

LookUpMoreThanOneResult = Findings 

End Function 

'below is the sub that works fine 

Sub look() 

Worksheets(1).Activate 

Dim ref As Range 

Dim arr As Range 
Dim va As Range 

Set ref = Range("j2:j7595") 
Set arr = Worksheets(2).Range("d2:d371") 

Dim r As Range 
Dim a As Range 


For Each r In ref.Cells 

     For Each a In arr.Cells 

      If r.Value = a.Value Then 
      r.Offset(0, 11).Value = r.Offset(0, 11).Value & vbCrLf & a.Offset(0, 6).Value 
      End If 


     Next a 

    Next r 

End Sub 

Answer 1

這就是答案，在這裏我不應該重複循環的LookUpFor細胞，和函數的返回值應該是字符串。 所以它現在好起來了，用戶可以使用它。

Function LookUpMoreThanOneResult(LookUpFor As Range, LookUpAt As Range, col As Integer) As String 

Dim R As Range 

     For Each R In LookUpAt 

      If LookUpFor.Value = R.Value Then 

      LookUpMoreThanOneResult = LookUpMoreThanOneResult & vbCrLf & R.Offset(0, col).Value 
      End If 

     Next R 


End Function