Вставить строки, если критерии из раскрывающихся списков соответствуют данным в таблице: пропустить часть кода, если ячейка, содержащая раскрывающийся список, оставлена ​​пустой - PullRequest
0 голосов
/ 08 марта 2019

На рабочем листе «Менеджер» пользователь выбирает в выпадающих списках критерии, которые будут использоваться для создания предложения.Как только все критерии выбраны, он запускает приведенный ниже макрос.Макрос выполняет поиск в столбцах «Компания», «Информация 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

1 Ответ

1 голос
/ 13 марта 2019

Две вещи:

  1. Если вы не хотите, чтобы код «останавливался», когда какой-либо из критериев пуст, тогда вам нужно добавить несколько Or операторов в свою логику:

    Если «поисковое значение» пусто ИЛИ «текущее значение» равно «поисковое значение» , тогда .. .

  2. Эффективный способ проверить наличие пустой строки в 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:


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


Вот более четкая картина того, что пытается сделать ОП:

Screenshot of tabs

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...