На рабочем листе «Менеджер» пользователь выбирает в выпадающих списках критерии, которые будут использоваться для создания предложения.Как только все критерии выбраны, он запускает приведенный ниже макрос.Макрос выполняет поиск в столбцах «Компания», «Информация A» и «Информация B» таблицы «Данные» по критериям соответствия.Каждый раз, когда он находит одну строку, в которой совпадают 3 критерия, он копирует диапазон P: W из совпадающей строки и вставляет его на лист «Цитата ENG» в A: H.
До тех пор, пока 3 критерияв «Менеджере» заполнены, соответствующие диапазоны будут вставлены в «Цитата ENG».Но если один или два критерия оставлены пустыми в «Менеджере», то ничего не вставляется в «Цитата ENG».Это нормально, поскольку в таблице «Данные» нет пустых ячеек, а оператор AND в коде связывает все критерии вместе.
Это не то поведение, которое я хочу.Мне нужно пропустить поиск-копирование-вставку любого критерия, который оставлен пустым в «Менеджере».Например, на приведенном ниже рисунке критерий из ячейки E9, «Информация B», оставлен пустым, поэтому он должен искать результаты только по критериям «Компания / Бренд» и «Информация A» на листе «Данные».,
Пример 3 рабочих листов
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.
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")
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