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语句 如果该语句为true，则会在newSHEET中添加一行 然后它将复制该行到新行 然后它将新行中的第一个单元格替换为newPART 然后它将再次遍历TitleHelper 对于TitleHelper中的每一行，它将通过IF语句 如果该语句为真，它将替换新行的第19 + n列
应该是代码的结尾，但是如果我将第一个IF语句的结尾放在P循环上方，它将仅在J循环的第一次迭代中执行第19 + n个替换，因为“ MHTROWmax = MHTROWmax +1“
如果第一个IF语句在第二个IF语句之前在“ Next P”之前结束，则会给我一个错误代码。
如果If语句保持原样，它将在J循环的第一次迭代中编写第19个+ n替换，然后为其他迭代做一些奇怪的事情。
我已包含我的工作表的副本 仅在“ MHT”处于活动状态时使用宏 （编辑：添加了应显示的结果页面。注意：您必须更改“结果”的名称才能运行宏） https://drive.google.com/file/d/1ZbmcIr_bRp_f6cngMeZevj7zujcdW1RC/view?usp=sharing
这也是预期结果的图像 Expected Results
答案 0 :(得分：0)
好吧，所以我通过实际执行最后一个循环（p循环）并使用i循环再次将其弄清楚了。因此，它实际上是2个双循环，而不是1个三重循环。绝对有更好的方法可以做到这一点，但是我很高兴我想出了所有解决办法。
因此基本上是前两个循环：
-遍历oldSHEET
-将复制的行从oldSHEET添加到newSHEET
-遍历TitleHelper
-如果语句为true，则将复制的行从oldSHEET添加到newSHEET
-将新行的第一个单元格更改为newPART
然后，我将oldSHEET和newSHEET的值更改为“ Result”，并新建一个工作表“ Result2”
后两个循环：
-遍历oldSHEET
-将复制的行从oldSHEET添加到newSHEET
-遍历TitleHelper
-如果语句为true，则替换新行的第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