Question

我正在尝试将工作表1中的列表与工作表2中的较长列表进行比较（我已将此部分工作）。然后我试图实现第二个声明，其中，如果在表2中找到第1页上的值，我想看看表2中另一列中的关联值是否是8个特定值之一（我存储在脚本中的数组集）。如果该单元格的值与数组中的某个项目匹配，我希望它将匹配及其数组值添加到单独工作表中的列表中。以下是我到目前为止（请原谅Frankenstein-ed这段代码的样子！）：

Sub status()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, lr1 As Long, lr2 As Long, rng1 As Range, rng2 As Range, rng3 As Range, c As Range
Dim vStages As Variant
Set sh1 = Sheets("FLEX")
Set sh2 = Sheets("WIP")
Set sh3 = Sheets("Report")

lr1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row
lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
Set rng1 = sh1.Range("A2:A" & lr1)
Set rng2 = sh2.Range("B2:B" & lr2)
Set rng3 = sh2.Range("D2:D" & lr2)

vStages = Array("Shipped", "Delivered", "Complete - Design", "Delivered to USPS", _
    "Delivered", "Complete - Fulfillment", "Complete - Inventory", "Complete - Mailing")

With sh3
    .Range("C1") = "Finished but not Invoiced"
End With

For Each c In rng1 
If WorksheetFunction.CountIf(rng2, "*" & c.Value & "*") = 1 And rng3 = vStages Then
        sh3.Cells(Rows.Count, 3).End(xlUp)(2) = c.Value
        sh3.Cells(Rows.Count, 4).End(xlUp)(2) = rng3.Value

End If

Next
End Sub

我知道问题发生在“And rng3 = vStages Then”部分，但我不知道如何正确设置该部分。任何帮助将不胜感激！

Answer 1

要测试数组rng3中是否存在vStages的值，您可以使用

... And Not IsError(Application.Match(rng3.Value, vStages, 0)) Then

如果数组中不存在查找值，

Application.Match将返回错误，因此，如果未返回错误，则表示数组中存在值。

我已更新您的代码，以使用Find找到＆＃34; WIP＆＃34;上的行。表格与＆＃34; FLEX＆＃34;上的数据相匹配片：

Sub status()
    Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, lr1 As Long, lr2 As Long, rng1 As Range, rng2 As Range, c As Range
    Dim vStages As Variant
    Dim FindCell As Range
    Set sh1 = Sheets("FLEX")
    Set sh2 = Sheets("WIP")
    Set sh3 = Sheets("Report")

    lr1 = sh1.Cells(sh1.Rows.Count, 1).End(xlUp).Row
    lr2 = sh2.Cells(sh2.Rows.Count, 1).End(xlUp).Row
    Set rng1 = sh1.Range("A2:A" & lr1)
    Set rng2 = sh2.Range("B2:B" & lr2)

    vStages = Array("Shipped", "Delivered", "Complete - Design", "Delivered to USPS", _
        "Delivered", "Complete - Fulfillment", "Complete - Inventory", "Complete - Mailing")

    With sh3
        .Range("C1") = "Finished but not Invoiced"
        For Each c In rng1
            'Search on WIP for the value from FLEX
            Set FindCell = rng2.Find(What:=c.Value, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
            'See if we found it
            If Not FindCell Is Nothing Then
                'Ensure that the value only appears once in WIP
                If rng2.FindNext(FindCell).Address = FindCell.Address Then
                    'Check the stage is one of the ones we are after
                    If Not IsError(Application.Match(FindCell.Offset(0, 2).Value, vStages, 0)) Then
                        'Store details
                        .Cells(.Rows.Count, 3).End(xlUp)(2) = c.Value 'Or maybe "= FindCell.Value" ?
                        .Cells(.Rows.Count, 4).End(xlUp)(2) = FindCell.Offset(0, 2).Value
                    End If
                End If
            End If
        Next
    End With
End Sub

修改以处理WIP中的每个匹配：

Sub status()
    Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, lr1 As Long, lr2 As Long, rng1 As Range, rng2 As Range, c As Range
    Dim vStages As Variant
    Dim FindCell As Range
    Dim FirstFind As String
    Set sh1 = Sheets("FLEX")
    Set sh2 = Sheets("WIP")
    Set sh3 = Sheets("Report")

    lr1 = sh1.Cells(sh1.Rows.Count, 1).End(xlUp).Row
    lr2 = sh2.Cells(sh2.Rows.Count, 1).End(xlUp).Row
    Set rng1 = sh1.Range("A2:A" & lr1)
    Set rng2 = sh2.Range("B2:B" & lr2)

    vStages = Array("Shipped", "Delivered", "Complete - Design", "Delivered to USPS", _
        "Delivered", "Complete - Fulfillment", "Complete - Inventory", "Complete - Mailing")

    With sh3
        .Range("C1") = "Finished but not Invoiced"
        For Each c In rng1
            'Search on WIP for the value from FLEX
            Set FindCell = rng2.Find(What:=c.Value, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
            'See if we found it
            If Not FindCell Is Nothing Then
                FirstFind = FindCell.Address
                'Loop through all occurrences
                Do
                    'Check the stage is one of the ones we are after
                    If Not IsError(Application.Match(FindCell.Offset(0, 2).Value, vStages, 0)) Then
                        'Store details
                        .Cells(.Rows.Count, 3).End(xlUp)(2) = c.Value 'Or maybe "= FindCell.Value" ?
                        .Cells(.Rows.Count, 4).End(xlUp)(2) = FindCell.Offset(0, 2).Value
                    End If
                    Set FindCell = rng2.FindNext(FindCell)
                    If FindCell.Address = FirstFind Then
                        Exit Do
                    End If
                Loop
            End If
        Next
    End With
End Sub

Excel VBA - 如果值匹配列表并且ALSO在数组中，则复制单元格

1 个答案: