Paste rows if criteria from dropdown lists match the data in the table: 如果包含下拉列表的单元格留空，则跳过部分代码

Question

在工作sheet“经理”中，用户在下拉列表中选择将用于创建报价单的条件。选择所有条件后，他将运行以下宏。宏在作品的“公司”、“信息A”、“信息B”栏中搜索sheet“数据”匹配条件。每次找到 3 个条件匹配的行时，它会从匹配行中复制范围 P:W 并将其粘贴到 sheet “Quotation ENG” in A:H.

只要在“Manager”中填写了3个条件，相应的范围就会粘贴到“Quotation ENG”中。但是，如果“经理”中有一个或两个标准留空，则“报价 ENG”中不会粘贴任何内容。这是正常的，因为“数据”table 中没有空白单元格，代码中的 AND 语句将所有条件链接在一起。

这不是我想要的行为。我需要跳过“经理”中留空的任何标准的搜索-复制-粘贴。例如在下图中，单元格 E9 中的条件“信息 B”留空，因此它应该只在“数据”中搜索条件“Company/Brand”和“信息 A”的结果” sheet。

Sample view of the 3 worksheets

Sub Quote()

    Dim Source As Worksheet
    Dim Target As Worksheet
    Dim Manager As Worksheet
    Dim Company() As String
    Dim InfoA As String
    Dim InfoB As String
    Dim Finalrow As Integer
    Dim counter As Integer
    Dim I As Integer

    Set Source = Worksheets("Data")
    Set Target = Worksheets("Quotation ENG")
    Set Manager = Worksheets("Manager")
    Company = Split(Worksheets("Manager").Range("E5").Value, ",")
    InfoA = Worksheets("Manager").Range("E7").Value
    InfoB = Worksheets("Manager").Range("E9").Value

    Finalrow = Source.Cells(Rows.Count, 1).End(xlUp).Row

    For counter = 0 To UBound(Company)

        For I = 2 To Finalrow
            If Source.Cells(I, 1) = Trim(Company(counter)) And Source.Cells(I, 2) = InfoA And Source.Cells(I, 3) = InfoB Then
               Source.Range(Source.Cells(I, 16), Source.Cells(I, 23)).Copy Target.Range("A200").End(xlUp).Offset(1, 0).Resize(1, 8)
            End If
        Next I
    Next counter

    Target.Activate
    Target.Range("A1").Select

End Sub

== 编辑 ==

这是 elektrykalAJ 修改后的工作。

子报价()

Dim Source As Worksheet
Dim Target As Worksheet
Dim Manager As Worksheet
Dim Company() As String
Dim InfoA As String
Dim InfoB As String
Dim finalrow As Integer
Dim counter As Integer
Dim I As Integer

Set Source = Worksheets("Data")
Set Target = Worksheets("Quotation ENG")
Set Manager = Worksheets("Manager")
InfoA = Worksheets("Manager").Range("E7").Value
InfoB = Worksheets("Manager").Range("E9").Value
finalrow = Source.Cells(Rows.Count, 1).End(xlUp).Row

If Worksheets("Manager").Range("E5").Value <> vbNullString Then
Company = Split(Worksheets("Manager").Range("E5").Value, ",")
Else
Company = Split("", "")
End If

For counter = 0 To UBound(Company)
lookupComp = Trim(Company(counter))

For I = 2 To finalrow

    thisComp = Source.Cells(I, 1)
    thisInfA = Source.Cells(I, 2)
    thisInfB = Source.Cells(I, 3)

    If (thisComp = lookupComp Or lookupComp = vbNullString) Then
        If (thisInfA = InfoA Or InfoA = vbNullString) Then
            If (thisInfB = InfoB Or InfoB = vbNullString) Then
                Source.Range(Source.Cells(I, 16), Source.Cells(I, 23)).Copy Target.Range("A200").End(xlUp).Offset(1, 0).Resize(1, 8)
            End If
        End If
    End If
Next I
Next counter

Target.Activate
Target.Range("A1").Select

End Sub

Answer 1

两件事：

如果您不希望代码在任何条件为空时“停止”，那么您需要在逻辑中添加一些 Or 语句：

If the "lookup value" is blank OR the "current value" equals the "lookup value" then...
检查 VBA 中空字符串的有效方法是与 vbNullString:
进行比较
If value = vbNullString Then ...

这是您修改后的代码：

我提取了一些变量并将 And 语句替换为 If 语句只是为了使其更易于阅读。我还将变量设为小写：

For counter = 0 To UBound(company)
    lookupComp = Trim(company(counter))

    For I = 2 To finalrow
        
        thisComp = source.Cells(I, 1)
        thisInfA = source.Cells(I, 2)
        thisInfB = source.Cells(I, 3)
        
        If (thisComp = lookupComp Or lookupComp = vbNullString) Then
            If (thisInfA = infoA Or infoA = vbNullString) Then
                If (thisInfB = infoB Or infoB = vbNullString) Then
                    source.Range(source.Cells(I, 16), source.Cells(I, 23)).Copy target.Range("A200").End(xlUp).Offset(1, 0).Resize(1, 8)
                End If
            End If
        End If
    Next I
Next counter

奖金：

如果 "Company" 可以为空，则在定义 company 变量时添加此检查：


If Worksheets("Manager").Range("E5").Value <> vbNullString Then
    company = Split(Worksheets("Manager").Range("E5").Value, ",")
Else
    company = Split("", "")
End If

这里更清楚地展示了 OP 正在尝试做什么：

Paste rows if criteria from dropdown lists match the data in the table: 如果包含下拉列表的单元格留空，则跳过部分代码

Paste rows if criteria from dropdown lists match the data in the table: skip part of the code if a cell containing a dropdown list is left blank

excel

vba

copy-paste

drop-down-menu