Скопировать строку с несколькими критериями в Excel VBA не работает, когда некоторые ячейки пусты

Question

Я пытаюсь скопировать строку из sheet1 в sheet2 с несколькими критериями, но мой код не работает, когда некоторые ячейки пустые в строке, где соблюдаются другие критерии.Я новичок в Excel Vba, поэтому, пожалуйста, извините меня, если у вопроса недостаточно описания.

 Sub TextBox1_Change()
    Sheets("Sheet2").Range(Cells(2, 1), Cells(49, 8)).Clear    
    Dim i As Long
    Dim client As String
    Dim bLength As String
    Dim span As String
    Dim height As String
    Dim baySpacing As String
    Dim siteLocation As String
    Dim comments As String
    Dim Lastrow As Long
    Dim Lastrowb As Long

    client = TextBox1.Text
    bLength = TextBox2.Value
    span = TextBox3.Value
    height = TextBox4.Value
    baySpacing = TextBox5.Value
    siteLocation = TextBox6.Text
    comments = TextBox7.Text

    Lastrow = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
    Lastrowb = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row + 1

    For i = 3 To Lastrow

        If InStr(UCase(Sheets(1).Cells(i, 1).Text), UCase(client)) And _
           InStr(Sheets(1).Cells(i, 2).Value, bLength) And _
           InStr(Sheets(1).Cells(i, 3).Value, span) And _
           InStr(Sheets(1).Cells(i, 4).Value, height) And _
           InStr(Sheets(1).Cells(i, 5).Value, baySpacing) And _
           InStr(UCase(Sheets(1).Cells(i, 6).Text), UCase(siteLocation)) And _
           InStr(UCase(Sheets(1).Cells(i, 7).Text), UCase(comments)) Then

            Sheets(1).Rows(i).Copy Destination:=Sheets(2).Rows(Lastrowb)
            Lastrowb = Lastrowb + 1

        End If
    Next
End Sub

Я хочу получить копию, даже если одна из ячеек пуста, тогда как другие критерии соответствуют.

Answer 1

Вы можете использовать функцию (и блок With) для упрощения ваших проверок:

For i = 3 To Lastrow
    With Sheets(1).Rows(i)
        If HasOrEmpty(.Cells(i, 1).Text), UCase(client)) And _
           HasOrEmpty(.Cells(i, 2).Value, bLength) And _
           HasOrEmpty(.Cells(i, 3).Value, span) And _
           HasOrEmpty(.Cells(i, 4).Value, height) And _
           HasOrEmpty(.Cells(i, 5).Value, baySpacing) And _
           HasOrEmpty(.Cells(i, 6).Text), UCase(siteLocation)) And _
           HasOrEmpty(.Cells(i, 7).Text), UCase(comments)) Then

           .Copy Destination:=Sheets(2).Rows(Lastrowb)
           Lastrowb = Lastrowb + 1

        End If
    End With
Next

Функция:

'return true if txt is empty or "lookFor" is contained in "Txt"
Function HasOrEmpty(txt, lookFor)
    HasOrEmpty = Len(txt)=0 Or InStr(txt, lookFor) > 0
End Function