以数组为值的多个IF AND循环浏览行。

Question

我有一个工作表，其中有3列A-C的文本，我想写一个VBA脚本来循环浏览每一行，如果（在每一行中）col a =（文本1或文本2）and col b =（文本5或文本6或文本7或文本8）and col c =（文本5或文本6或文本7或文本8）。

我想写一个VBA脚本来循环浏览每一行，如果（在每一行中）col a=（文本1或文本2）and col b=（Text5或文本6或文本7或文本8）and col c=（Text20或文本22）在D列中填入 "是"。

我想把要搜索的文本值放在多个数组中。

Dim Search1 As Variant
Dim Search2 as Variant
Dim Search3 as Variant

Search1 = Array("Cat", "Dog")
Search2 = Array("Red", "Brown", "Blue")
Search2 = Array("House", "Condo")

然后对这些行进行循环

Dim i As Long
For i = 1 To rg.Rows.Count

我的问题是搜索逻辑。

Application.CountIFs(Cells(i,1),Search1, Cells(i,2), Search2, Cells(i,3), Search4)) > 0 then
sh.Cells(i, "F").Value = "yes"
i = i + 1
End if
Next i

所以就像..:

A    B       C      D       
Dog    Brown House  Y       A=(Dog or Cat) AND  B=(Brown or Blue or Red)  AND C =( House or Condo)
Bird   Blue  House          
Cat    Brown Condo  Y       
Cat    Pink  Condo          
Cat    Blue  House  Y       
Horse  Red   Condo          
Cat    Green House          
Dog    Pink  Condo          
Horse  Blue  House      

我希望这有意义......我真的想知道如何为每一行做countIF(Range, Array, Range,Array, Rang, Array)。

谢谢你！我有一个工作表，里面有3行。

Answer 1

三重匹配

Option Explicit

Sub TripleMatch()

    ' Define constants.
    Const SheetName As String = "Sheet1"
    Const Cols As String = "A:C"
    Const FirstRow As Long = 2
    Const TargetColumn As Long = 4
    Const StringValue As String = "Yes"
    Dim Search(2) As Variant
    Search(0) = Array("Cat", "Dog")
    Search(1) = Array("Red", "Brown", "Blue")
    Search(2) = Array("House", "Condo")

    ' Write values of Source Range to Source Array.
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(SheetName)
    Dim FirstColumn As Long
    FirstColumn = ws.Columns(Cols).Column
    Dim rng As Range
    Set rng = ws.Columns(FirstColumn).Find("*", , xlValues, , , xlPrevious)
    If rng Is Nothing Then Exit Sub
    If rng.Row < FirstRow Then Exit Sub
    Dim Source As Variant
    Source = Intersect(ws.Range(ws.Cells(FirstRow, FirstColumn), rng) _
      .EntireRow.Rows, ws.Columns(Cols))

    ' Check Source Array and write to Target Array.
    Dim Target As Variant
    ReDim Target(1 To UBound(Source), 1 To 1)
    Dim i As Long, j As Long
    For i = 1 To UBound(Source)
        GoSub CheckValue
    Next i

    ' Write values of Target Array to Target Range.
    ws.Cells(FirstRow, TargetColumn).Resize(UBound(Target)).Value = Target

    ' Inform user.
    MsgBox "TripleMatch finished successfully.", vbInformation, "Success"

    Exit Sub

CheckValue:
    For j = 1 To UBound(Source, 2)
        If IsError(Application.Match(Source(i, j), Search(j - 1), 0)) Then
            Return
        End If
    Next j
    Target(i, 1) = StringValue
    Return

End Sub