在几个单元格中并检查几个范围的vba代码

Question

有人能帮忙吗我在几个单元格中有这个公式，检查了几个范围！有没有办法将其转换为VBA，这样我只需在每个单元格中选择一个区域？

谢谢你的帮助。

=IF(COUNTIF(BE95:BE99;"Falhou")>0;"Falhou";IF(COUNTIF(BE95:BE99;"Falhou Condicionamente")>0;"Falhou Condicionamente";IF(COUNTIF(BE95:BE99;"Passou Condicionamente")>0;"Passou Condicionamente";IF(COUNTIF(BE95:BE99;"Passou")>0;"Passou"))))

Answer 1

也许这就是您想要的，为了让它发挥作用，让我们插入一个模块并将此代码放入该模块中。

然后只需键入以下公式：

= Test (BE95: BE99)

Function test(rng As Range)
Dim str As Variant
For Each str In Array("Falhou", "Falhou Condicionamente", "Passou Condicionamente", "Passou")
If Not IsError(Application.Match(str, rng, 0)) Then test = str:Exit for 'if match exist then return value
Next str
End Function

Answer 2

下面的函数有一个您的工作表函数没有的功能：如果范围不包含4个计数条件，它将返回"Falhou"。

Function Passou(Rng As Range) As String
'    '=IF(COUNTIF(BE95:BE99;"Falhou")>0;"Falhou";
'    IF(COUNTIF(BE95:BE99;"Falhou Condicionamente")>0;"Falhou Condicionamente";
'    IF(COUNTIF(BE95:BE99;"Passou Condicionamente")>0;"Passou Condicionamente";
'    IF(COUNTIF(BE95:BE99;"Passou")>0;"Passou"))))
Dim Sp() As String
Dim i As Integer
Sp = Split("Falhou,Falhou Condicionamente,Passou Condicionamente,Passou", ",")
For i = UBound(Sp) To 1 Step -1
If Application.CountIf(Rng, Sp(i)) Then Exit For
Next i
Passou = Sp(i)
End Function

从指定要搜索的范围的工作表中调用UDF。

= Passou($BE$95:$BE$99)

通过对范围进行绝对寻址，可以跨行和列复制公式。