去范围并添加具有特定值的单元格到一个新的范围

我在Excel中与vba有点新。 我试图做一个函数来检查特定文本的范围，并将包含该值的单元格添加到新的范围。 并返回新的范围。

我在brettdj上find了几乎相同的代码，并对我的情况进行了一些修改。

function如下所示：

Function Test(Testvalue As String, TargetRange As Range) As Range Dim rng2 As Range Dim c As Range For Each c In TargetRange If c.Text = Testvalue Then If Not rng2 Is Nothing Then ' Add the 2nd, 3rd, 4th etc cell to our new range, rng2 ' this is the most common outcome so place it first in the IF test (faster coding) Set rng2 = Union(rng2, c) Else ' the first valid cell becomes rng2 Set rng2 = c End If End If Next Set Test = rng2 End Function 

但是，当我把这个在Excel中使用，例如在= IsBlank（testing（苹果; A1：A5）），它返回一个#VALUE !.

有人有一个想法如何我可以得到这个工作。 许多thz提前

Answer 1

单元格地址是Stringtypes，而不是一个Rangetypes，所以你不能从函数返回。 用户定义的函数（UDF）不能返回Range对象。 你可以做的是返回每个单元格的地址：

 Function Test(Testvalue As String, TargetRange As Range) As String Dim rng2 As String Dim c As Range For Each c In TargetRange If c.Text = Testvalue Then If rng2 <> vbNullString Then ' Add the 2nd, 3rd, 4th etc cell to our new range, rng2 ' this is the most common outcome so place it first in the IF test (faster coding) rng2 = rng2 & "," & c.Address Else ' the first valid cell becomes rng2 rng2 = c.Address End If End If Next Test = rng2 End Function 

这个函数的输出是一个逗号分隔的string地址列表。 （B3包含公式，B2显示B3中公式的外观）

要使用这个单元格地址串，你必须创build一个不同的UDF（尽pipeUDF不能修改不同的单元格的内容或格式）：

 Function test2(TestValue As String) As String Dim c As Range For Each c In Range(TestValue) MsgBox "The cell's address is: " & c.Address Next c test2 = "Last calculated on " & Now() End Function 

如果您试图以任何方式修改包含文本“Apple”的单元格，则应考虑使用不同的方法。

Answer 2

额外的变体已经提供

 Function Test(Testvalue As String, TargetRange As Range) As String Dim d As Object: Set d = CreateObject("Scripting.Dictionary") Dim c As Range For Each c In TargetRange If c.Value2 = Testvalue Then d.Add c.Address(0, 0), "" Next Test = Join(d.keys, ","): Set d = Nothing End Function