Хорошо, так что я понял это, взяв последний цикл (цикл 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