В VBA цикл с несколькими условиями «И» вместе с «Или» вместе, группируя их? - PullRequest
Новая
       30

В VBA цикл с несколькими условиями «И» вместе с «Или» вместе, группируя их?

0 голосов
/ 28 февраля 2020

Я пытаюсь создать код для проверки двух условий одновременно из моего файла данных. В настоящее время мой сценарий работает нормально, потому что он проверяет только название бренда в столбце A. Однако я также хочу проверить категорию в столбце B: "Sun" или "Vista". Конструктивно я хочу что-то вроде: 

For i = 2 to Last_row
If Cells(i,1).value = "BananaRepublic" and Cells(i, 2).value = "Sun" or "Vista" then,
   Row(i).Copy
   Worksheet(new_worksheet).Paste

Пожалуйста, обратите внимание: в среднем есть более 30 различных брендов, которые мне нужно указать в этом списке, которые должны соответствовать их значению в столбце B (Sun / Vista ), а затем мне нужно повторить это для 20 различных макросов, каждый для различной комбинации названий брендов и категории Sun / Optical. Делать это по отдельности кажется очень неэффективным. Есть ли лучшее решение?

Вот что я уже сделал: 

Option Compare Text

Sub StarOptical()

'Define all variables
Dim customer_name As String
Dim sheetName As String

sName = ActiveSheet.Name

'ActiveWorkbook.Worksheets(sName).Sort.SortFields.Clear

'Enter the Customer Name here
customer_name = "StarOptical"
Sheets.Add.Name = customer_name

'Copy same header to the new worksheet
Worksheets(sName).Rows(1).Copy
Worksheets(customer_name).Cells(1, 1).Select
ActiveSheet.Paste

'Find the last row of the report
last_row = Worksheets(sName).Cells(Rows.Count, 1).End(xlUp).Row


'Start the loop and scan through each row for listed brands
For i = 2 To last_row
    'Update the names of the approved brands in the line below
    If Worksheets(sName).Cells(i, 1).Value = "ADENSCO" Or Worksheets(sName).Cells(i, 1).Value = "BANANAREPUBLI" Or Worksheets(sName).Cells(i, 1).Value = "BOSS(HUB)" Then

        Worksheets(sName).Rows(i).Copy
        Worksheets(customer_name).Activate
        last_row_new = Worksheets(customer_name).Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets(customer_name).Cells(last_row_new + 1, 1).Select
        ActiveSheet.Paste

    End If
Next

Application.CutCopyMode = False
Worksheets(customer_name).Cells(1, 1).Select


End Sub

1 Ответ

0 голосов
/ 28 февраля 2020

Вы можете сделать что-то вроде этого: 

Sub tester()

    CreateSheet "BananaRepublic", Array("Sun", "Vista")
    'etc for other sheets

End Sub


Sub CreateSheet(sBrand As String, arrVals)

    Dim wsSrc As Worksheet, wsDest As Worksheet, i As Long, c As Range

    Set wsSrc = ActiveSheet
    Set wsDest = wsSrc.Parent.Sheets.Add()

    wsDest.Name = sBrand
    wsSrc.Rows(1).Copy wsDest.Cells(1, 1)
    Set c = wsDest.Cells(2, 1)

    For i = 2 To wsSrc.Cells(Rows.Count, 1).End(xlUp).Row
        'match on ColA?
        If wsSrc.Cells(i, 1).Value = sBrand Then
            'match on colB ?
            If Not IsError(Application.Match(wsSrc.Cells(i, 2).Value, arrVals, 0)) Then
                wsSrc.Rows(i).Copy c     'copy the row
                Set c = c.Offset(1, 0)   'next cell down for copy destination
            End If
        End If
    Next

End Sub
...