Цикл внутри оператора If внутри двух циклов - PullRequest
0 голосов
/ 05 июня 2019
Sub aaa()
Dim childROWmax    As Long
Dim parentROWmax   As Long
Dim i              As Long
Dim j              As Long
Dim z              As Long
Dim p              As Long
Dim n              As Long
Dim parentPATTERN  As Range
Dim parentPATTERN2 As Range
Dim parentWEIGHT   As Range
Dim childPATTERN   As Range
Dim oMAX           As Range
Dim oMIN           As Range
Dim childCODE      As Range
Dim parentPART     As Range
Dim newPART        As String
Dim newSHEET       As Worksheet
Dim oldSHEET       As Worksheet

Set oldSHEET = ActiveSheet
parentROWmax = oldSHEET.Cells(Rows.Count, 1).End(xlUp).Row
Set newSHEET = ThisWorkbook.Sheets.Add(After:= _
             ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    newSHEET.Name = "Result"
childROWmax = Sheets("TitleHelper").Cells(Rows.Count, 1).End(xlUp).Row
MHTROWmax = newSHEET.Cells(Rows.Count, 1).End(xlUp).Row


    For i = 2 To parentROWmax
        z = 1
        n = 0

        'Increment Result sheet row
        MHTROWmax = MHTROWmax + 1

        'get MHT row info for comparison
           Set parentPATTERN = oldSHEET.Range("J" & i)
           Set parentPATTERN2 = oldSHEET.Range("K" & i)
           Set parentWEIGHT = oldSHEET.Range("H" & i)
           Set parentPART = oldSHEET.Range("A" & i)

        'Write a row to MHT Result Table
        oldSHEET.Rows(i).Copy newSHEET.Rows(MHTROWmax)

        For j = 2 To childROWmax

            'get TitleHelper row info for comparison
            Set childPATTERN = Worksheets("TitleHelper").Range("A" & j)
            Set oMAX = Worksheets("TitleHelper").Range("C" & j)
            Set oMIN = Worksheets("TitleHelper").Range("B" & j)
            Set childCODE = Worksheets("TitleHelper").Range("F" & j)
            newPART = parentPART & "*" & childCODE

            'Perform if/then
            If (parentPATTERN = childPATTERN _
                Or parentPATTERN2 = childPATTERN) _
               And parentWEIGHT <= oMAX _
               And parentWEIGHT >= oMIN _
               And z < 5 Then
                   z = z + 1

                'Increment Result sheet row
                MHTROWmax = MHTROWmax + 1

                'Criteria is met, write a row to MHT Result Table
                oldSHEET.Rows(i).Copy newSHEET.Rows(MHTROWmax)
                newSHEET.Cells(MHTROWmax, 1) = newPART
                    For p = 2 To childROWmax

                         If (parentPATTERN = Worksheets("TitleHelper").Range("A" & p) _
                          Or parentPATTERN2 = Worksheets("TitleHelper").Range("A" & p)) _
                          And parentWEIGHT <= Worksheets("TitleHelper").Range("C" & p) _
                          And parentWEIGHT >= Worksheets("TitleHelper").Range("B" & p) _
                         And n < 4 Then
                             n = n + 1

                          newSHEET.Cells(MHTROWmax, 19 + n) = Worksheets("TitleHelper").Range("E" & p).Value
                         End If
                    Next p
                End If
        Next j
    Next i
End Sub

Так что у меня есть этот код VBA, где он проходит по листу (oldSHEET) для каждой строки в oldSHEET это добавит строку в newSHEET тогда он скопирует строку в новую строку тогда он будет проходить через другой лист (TitleHelper) для каждой строки в TitleHelper она будет проходить через оператор IF Если утверждение верно, оно добавит строку в newSHEET тогда он скопирует строку в новую строку тогда он заменит первую ячейку в новой строке на newPART тогда он снова будет проходить через TitleHelper для каждой строки в TitleHelper она будет проходить через оператор IF Если утверждение истинно, оно заменит 19-й столбец + n в новой строке

это должен быть конец кода, но если я поставлю конец первого оператора IF над циклом P, он выполнит только 19-ю + n замену на первой итерации цикла J из-за "MHTROWmax = MHTROWmax + 1 "

Если первый оператор IF заканчивается перед "Next P" вторым оператором IF, он дает мне код ошибки.

Если операторы If остаются такими же, как они, они напишут 19-ю + n замену на первой итерации цикла J, а затем сделают некоторые странные вещи для других итераций.

Я включил копию моего листа просто используйте макрос, когда "MHT" активен (РЕДАКТИРОВАТЬ: добавил страницу результатов, как она должна отображаться. Примечание: вам нужно изменить имя «результата» для запуска макроса) https://drive.google.com/file/d/1ZbmcIr_bRp_f6cngMeZevj7zujcdW1RC/view?usp=sharing

Вот изображение ожидаемого результата, а также Ожидаемые результаты

1 Ответ

0 голосов
/ 10 июня 2019

Хорошо, так что я понял это, взяв последний цикл (цикл p) и повторив цикл снова с циклом i. Так что на самом деле это 2 двойных цикла вместо 1 тройного цикла. Определенно, есть лучший способ сделать это, но я рад, что нашел какое-либо решение.

Итак, в основном первые два цикла:

- проходит через oldSHEET

- добавляет скопированную строку в newSHEET из oldSHEET

- проходит через TitleHelper

- Если оператор верен, то добавляет скопированную строку в newSHEET из oldSHEET

- Измените первую ячейку новой строки на newPART

Затем я изменяю значения oldSHEET и newSHEET на «Result» и новый лист «Result2»

Вторые две петли:

- проходит через oldSHEET

- добавляет скопированную строку в newSHEET из oldSHEET

- проходит через TitleHelper

- Если утверждение верно, то заменить 19-й столбец + n в новой строке

Sub ParentPartOne()
    Dim childROWmax    As Long
    Dim parentROWmax   As Long
    Dim i              As Long
    Dim j              As Long
    Dim z              As Long
    Dim p              As Long
    Dim parentPATTERN  As Range
    Dim parentPATTERN2 As Range
    Dim parentWEIGHT   As Range
    Dim childPATTERN   As Range
    Dim oMAX           As Range
    Dim oMIN           As Range
    Dim childCODE      As Range
    Dim parentPART     As Range
    Dim newPART        As String
    Dim newSHEET       As Worksheet
    Dim oldSHEET       As Worksheet

    Set oldSHEET = ActiveSheet
    parentROWmax = oldSHEET.Cells(Rows.Count, 1).End(xlUp).Row
    Set newSHEET = ThisWorkbook.Sheets.Add(After:= _
                                           ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    newSHEET.Name = "Result"
    childROWmax = Sheets("TitleHelper").Cells(Rows.Count, 1).End(xlUp).Row
    MHTROWmax = newSHEET.Cells(Rows.Count, 1).End(xlUp).Row


    For i = 2 To parentROWmax
        z = 1
        n = 0

       'Increment Result sheet row
        MHTROWmax = MHTROWmax + 1

       'get MHT row info for comparison
        Set parentPATTERN = oldSHEET.Range("J" & i)
        Set parentPATTERN2 = oldSHEET.Range("K" & i)
        Set parentWEIGHT = oldSHEET.Range("H" & i)
        Set parentPART = oldSHEET.Range("A" & i)

       'Write a row to MHT Result Table
        oldSHEET.Rows(i).Copy newSHEET.Rows(MHTROWmax)

        For j = 2 To childROWmax

           'get TitleHelper row info for comparison
            Set childPATTERN = Worksheets("TitleHelper").Range("A" & j)
            Set oMAX = Worksheets("TitleHelper").Range("C" & j)
            Set oMIN = Worksheets("TitleHelper").Range("B" & j)
            Set childCODE = Worksheets("TitleHelper").Range("F" & j)
            newPART = parentPART & "*" & childCODE

           'Perform if/then
            If (parentPATTERN = childPATTERN _
            Or parentPATTERN2 = childPATTERN) _
            And parentWEIGHT <= oMAX _
            And parentWEIGHT >= oMIN _
            And z < 5 Then
                z = z + 1

               'Increment Result sheet row
                MHTROWmax = MHTROWmax + 1

               'Criteria is met, write a row to MHT Result Table
                oldSHEET.Rows(i).Copy newSHEET.Rows(MHTROWmax)
                newSHEET.Cells(MHTROWmax, 1) = newPART
            End If
        Next j
    Next i

    Set oldSHEET = Sheets("Result")
    parentROWmax = oldSHEET.Cells(Rows.Count, 1).End(xlUp).Row
    Set newSHEET = ThisWorkbook.Sheets.Add(After:= _
                                           ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    newSHEET.Name = "Result2"
    childROWmax = Sheets("TitleHelper").Cells(Rows.Count, 1).End(xlUp).Row
    MHTROWmax = newSHEET.Cells(Rows.Count, 1).End(xlUp).Row

    For i = 2 To parentROWmax
        z = 1
        n = 0

       'Increment Result sheet row
        MHTROWmax = MHTROWmax + 1

       'get MHT row info for comparison
        Set parentPATTERN = oldSHEET.Range("J" & i)
        Set parentPATTERN2 = oldSHEET.Range("K" & i)
        Set parentWEIGHT = oldSHEET.Range("H" & i)
        Set parentPART = oldSHEET.Range("A" & i)

       'Write a row to MHT Result Table
        oldSHEET.Rows(i).Copy newSHEET.Rows(MHTROWmax)

        For p = 2 To childROWmax

        If (parentPATTERN = Worksheets("TitleHelper").Range("A" & p) _
        Or parentPATTERN2 = Worksheets("TitleHelper").Range("A" & p)) _
        And parentWEIGHT <= Worksheets("TitleHelper").Range("C" & p) _
        And parentWEIGHT >= Worksheets("TitleHelper").Range("B" & p) _
        And n < 4 Then
            n = n + 1

                newSHEET.Cells(MHTROWmax, 19 + n) = Worksheets("TitleHelper").Range("E" & p).Value
            End If
        Next p
    next i

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