匹配多个条件的代码无法处理不匹配/中断

Question

行动可以分解如下：

1. 在工作表src2中，我使用复选框选择条件（可选择多个选项
）
2. 根据所选标准，代码转到工作表src并查找匹配
3. 匹配项目将导出到另一个Dst

代码工作正常，但在src2表中选择以下条件的情况除外：

 - Criteria 1 - selected
 - Criteria 2 - not selected
 - Criteria 3 - selected

这意味着代码无法处理选择之间的差距。它没有错误。什么都没有出口。

Dim rngSelectionTable As Range
Dim tempfolderpath As String
Dim Crit As String                                                          

Set rngSelectionTable = src2.Range("options_selectiontable")                

For temprow = 1 To rngSelectionTable.Rows.Count                             
    tempselected = rngSelectionTable(temprow, 2).Value   ' Checkbox value column
    Crit = rngSelectionTable(temprow, 5).Value           ' Criteria value column
    If tempselected = True Then                          ' If checkbox selected, then ...

            For Each r In src.Range("P4:P" & LastRow)    ' Analysis range in Sheet src
                If r <> 0 Then strValue = r              ' If cell in src is Non-Empty
                If strValue = Crit Then              ' If cell in Modules_List = Criteria
                    If CopyRange Is Nothing Then       ' If nothing copied before, then
                            Set CopyRange = r.EntireRow       ' Copy entire row
                    Else
                            Set CopyRange = Union(CopyRange, r.EntireRow) ' Else - add this row to previously copies
                    End If
                End If
            Next r
        End If
    Next temprow

    If Not CopyRange Is Nothing Then

    CopyRange.Copy
    Dst.Range("A324").Insert xlShiftDown     ' Starting cell for INSERTing the range
    End If

Answer 1

将联合范围到目标工作表的最后一个操作失败。只要该范围由不连续的行组成，就不能在“插入复制的单元格”操作中使用它。在工作表上手动尝试，您将看到该选项不可用。

您可以遍历联合范围的Range.Areas property和复制，插入每个连续范围（也称为区域）的复制单元格。

Dim a As Range
If Not copyRange Is Nothing Then
    For Each a In copyRange.Areas
        'Debug.Print a.Address(0, 0)
        a.Copy
        dst.Range("A324").Insert xlShiftDown     ' Starting cell for INSERTing the range
    Next a
End If