Установите переменную с несколькими операторами IF, связанными с циклом FOR со счетчиком

Question

у меня 3 листа. На листе «Менеджер» есть 7 выпадающих списков для критериев: H5, H7, H9, H11, H13, H15, H17. Как только критерии выбраны, и пользователь нажимает кнопку «КОПИРОВАНИЕ», макрос ищет на листе «Данные» столбцы A:G строк, соответствующих выбранным критериям. Затем он копирует диапазон P:W для соответствующих строк и вставляет его в лист «Цитата», начиная со строки 11. Важно отметить, что когда пользователь не выбирает критерий для какого-либо из раскрывающегося списка, тогда этот критерий просто игнорируется (см. VbNullString в коде)

К настоящему времени макрос работает нормально с множественным выбором критериев для раскрывающегося списка Компании (H5) и выбором одного критерия для других (H7, H9, H11, H13, H15, H17).

Sub Quote()

Dim Source As Worksheet
Dim Target As Worksheet
Dim Manager As Worksheet
Dim Multiple () As String 'Here
Dim InfoA As String
Dim InfoB As String
Dim InfoC As String
Dim ProductType As String
Dim SalesStatus As String
Dim finalrow As Integer
Dim counter As Integer
Dim I As Integer

Set Source = Worksheets("Data")
Set Target = Worksheets("Quote")
Set Manager = Worksheets("Manager")
If Worksheets("Manager").Range("H5").Value <> vbNullString Then 'Here
Multiple = Split(Worksheets("Manager").Range("H5").Value, ",") 'Here
   If Worksheets("Manager").Range("H13").Value <> vbNullString Then 'Modified
   Multiple = Split(Worksheets("Manager").Range("H13").Value, ",") 'Here

      Else 'Here
      Multiple = Split("", "") 'Here
   End If 'Here
End If 'Here
InfoA = Worksheets("Manager").Range("H7").Value
InfoB = Worksheets("Manager").Range("H9").Value
InfoC = Worksheets("Manager").Range("H11").Value
ProductType = Worksheets("Manager").Range("H15").Value
SalesStatus = Worksheets("Manager").Range("H17").Value
finalrow = Source.Cells(Rows.Count, 1).End(xlUp).Row


For counter = 0 To UBound(Multiple) 'Here
lookupMult = Trim(Multiple(counter)) 'Here

For I = 2 To finalrow

    thisComp = Source.Cells(I, 1)
    thisInfA = Source.Cells(I, 2)
    thisInfB = Source.Cells(I, 3)
    thisInfC = Source.Cells(I, 4)
    thisProd = Source.Cells(I, 5)
    thisType = Source.Cells(I, 6)
    thisSale = Source.Cells(I, 7)

    If (thisComp = lookupMult Or lookupMult = vbNullString) Then 'Here
        If (thisInfA = InfoA Or InfoA = vbNullString) Then
            If (thisInfB = InfoB Or InfoB = vbNullString) Then
                If (thisInfC = InfoC Or InfoC = vbNullString) Then
                    If (thisProd = lookupMult Or lookupMult = vbNullString) Then 'Here
                        If (thisType = ProductType Or ProductType = vbNullString) Then
                            If (thisSale = SalesStatus Or SalesStatus = 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
                End If
            End If
        End If
    End If
Next I
Next counter

End Sub

В дополнение к множественному выбору критериев для H5, мне также необходимо включить его для Продукта (H13). Для этого я попытался изменить переменную Company, используя более сложное утверждение IF. На картинке лист "Цитата" - это результат, который я должен получить. Но на самом деле ничего не копируется, и я не могу понять, что я делаю неправильно. Я добавил несколько комментариев «Здесь, чтобы показать, какую часть кода я изменил. Заранее спасибо за любые рекомендации.

Answer 1

Я нашел способ решить мою проблему.Это не серебряная пуля, но, по крайней мере, она работает как надо.После, если кто-нибудь знает какой-либо способ оптимизации кода, кроме запросов SQL и структурированных таблиц, не стесняйтесь делиться, и я постараюсь.Примечание. Я полагаю, что SQL-запросы, вероятно, являются лучшим вариантом, но это означает, что мне нужно переделать почти весь мой код и использовать методы, которых я не знаю (пока).Я изучу его позже для будущего обновления.

Проблема в том, что слово "counter" может быть зарезервированной переменной.Таким образом, я не был уполномочен добавлять еще один FOR в мой цикл, разделяющий подобные функции.Поскольку я изменил переменную "counter" по буквам, я теперь могу сделать несколько критериев выбора для других выпадающих списков.В приведенном ниже примере я только что сделал это для H5 и H13, чтобы было ясно.

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 InfoC As String
Dim Product () As String
Dim ProductType As String
Dim SalesStatus As String
Dim finalrow As Integer
Dim I As Integer
Dim J As Integer
Dim K As Integer

Set Source = Worksheets("Data")
Set Target = Worksheets("Quote")
Set Manager = Worksheets("Manager")
If Worksheets("Manager").Range("H5").Value <> vbNullString Then 
Company= Split(Worksheets("Manager").Range("H5").Value, ",") 
Else 
Company = Split("", "") 
End If 
InfoA = Worksheets("Manager").Range("H7").Value
InfoB = Worksheets("Manager").Range("H9").Value
InfoC = Worksheets("Manager").Range("H11").Value
If Worksheets("Manager").Range("H13").Value <> vbNullString Then 
Product = Split(Worksheets("Manager").Range("H13").Value, ",") 
Else 
Product = Split("", "") 
End If 
ProductType = Worksheets("Manager").Range("H15").Value
SalesStatus = Worksheets("Manager").Range("H17").Value
finalrow = Source.Cells(Rows.Count, 1).End(xlUp).Row


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

For J = 0 To UBound(Product) 
lookupProd = Trim(Product(J))  

For I = 2 To finalrow

thisComp = Source.Cells(I, 1)
thisInfA = Source.Cells(I, 2)
thisInfB = Source.Cells(I, 3)
thisInfC = Source.Cells(I, 4)
thisProd = Source.Cells(I, 5)
thisType = Source.Cells(I, 6)
thisSale = Source.Cells(I, 7)

If (thisComp = lookupComp Or lookupComp = vbNullString) Then
    If (thisInfA = InfoA Or InfoA = vbNullString) Then
        If (thisInfB = InfoB Or InfoB = vbNullString) Then
            If (thisInfC = InfoC Or InfoC = vbNullString) Then
                If (thisProd = lookupProd Or lookupProd = vbNullString) Then
                    If (thisType = ProductType Or ProductType = vbNullString) Then
                        If (thisSale = SalesStatus Or SalesStatus = 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
            End If
        End If
    End If
End If
Next I
Next J
Next K

End Sub