使用 If 条件退出 For 循环 VBA/VB

Question

我正在为我的 CAD 程序创建一个第三方插件，其中有一个子插件，它通过绘图并查找所有部件列表 (BOMS)，如果部件列表中的任何项目在 BOM (1例如，零件在 2 个焊件中使用）然后它将第二个实例的项目编号更改为第一个实例的项目编号。它通过比较两个值之间的完整文件名来做到这一点。当他们匹配时，将数字更改为匹配器的数字。我已经让它工作了，但它运行有点慢，因为对于 100 个项目的 BOM，每个项目都与 100 个进行比较，因此需要的时间比我想要的要长一些（运行大约 60 秒）。想了想，我意识到我不需要将每个项目与所有项目进行比较，我只需要比较直到找到重复项，然后退出搜索循环并转到下一个值。示例是 Item 1 不需要与其余 99 个值进行比较，因为即使它在位置 100 确实有匹配项，我也不想将 item 1s 的编号更改为 item 100 的编号。我想将 item 100 更改为那个为 1（即，将重复项更改为第一个遇到的双份）。但是，对于我的代码，我在退出循环比较时遇到了麻烦，这给我带来了麻烦。麻烦的一个例子是这样的：

我有 3 个 BOM，每个都共享第 X 部分，并且在 BOM 1 中编号为 1，在 BOM 2 中编号为 4，在 BOM 3 中编号为 7。当我运行按钮时，因为我无法让它离开比较循环发现它首先匹配所有从 BOM 3 获得项目编号 7 的 Part X，因为它是最后一个实例。 （我可以通过向后逐步执行我的 for 循环来完成我想做的事情，因此所有事情最终都是最常见的，但我想让我的退出 fors 工作，因为它可以节省我不必要的比较）

如何使用 if 条件跳出嵌套的 for 循环？

这是我当前的代码：

Public Sub MatchingNumberR1()

Debug.Print ThisApplication.Caption

'define active document as drawing doc. Will produce an error if its not a drawing doc
    Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = ThisApplication.ActiveDocument

    'Store all the sheets of drawing
    Dim oSheets As Sheets
    Set oSheets = oDrawDoc.Sheets
    
    Dim oSheet As Sheet
        
        'Loop through all the sheets
        For Each oSheet In oSheets

        Dim oPartsLists As PartsLists
        Set oPartsLists = oSheet.PartsLists
        
        'Loop through all the part lists on that sheet
        Dim oPartList As PartsList
        
            'For every parts list on the sheet
            For Each oPartList In oPartsLists
            
                For i3 = 1 To oPartList.PartsListRows.Count
                
                    'Store the Item number and file referenced in that row to compare
                    oItem = FindItem(oPartList)
                    oDescription = FindDescription(oPartList)
                    oDescripCheck = oPartList.PartsListRows.Item(i3).Item(oDescription).Value
                    oNumCheck = oPartList.PartsListRows.Item(i3).Item(oItem).Value
                    
                    
                    'Check to see if the BOM item is a virtual component if it is do not try and get the reference part
                    If oPartList.PartsListRows.Item(i3).ReferencedFiles.Count = 0 Then
                        oRefPart = " "
                    End If
                    
                    'Check to see if the BOM item is a virtual component if it is try and get the reference part
                    If oPartList.PartsListRows.Item(i3).ReferencedFiles.Count > 0 Then
                        oRefPart = oPartList.PartsListRows.Item(i3).ReferencedFiles.Item(1).FullFileName
                    End If
                    
                    MsgBox (" We are comparing " & oRefPart)
                    
    '''''Create a comparison loop to go through the drawing that checks the oRefPart against other BOM items and see if there is a match.'''''
    
    
    
    'Store all the sheets of drawing
    
                Dim oSheets2 As Sheets
                Set oSheets2 = oDrawDoc.Sheets
                Dim oSheet2 As Sheet
        
        
                    'For every sheet in the drawing
                    For Each oSheet2 In oSheets2

                    'Get all the parts list on a single sheet
                    Dim oPartsLists2 As PartsLists
                    Set oPartsLists2 = oSheet2.PartsLists
                    Dim oPartList2 As PartsList
       
            
                        'For every parts list on the sheet
                        For Each oPartList2 In oPartsLists2
            
                            oItem2 = FindItem(oPartList2)
                            oDescription2 = FindDescription(oPartList2)
                
            
                            'Go through all the rows of the part list
                            For i6 = 1 To oPartList2.PartsListRows.Count
                
                                'Check to see if the part is a not a virtual component, if not, get the relevent comparison values
                                If oPartList2.PartsListRows.Item(i6).ReferencedFiles.Count > 0 Then
                     
                                    oNumCheck2 = oPartList2.PartsListRows.Item(i6).Item(oItem2).Value
                                    oRefPart2 = oPartList2.PartsListRows.Item(i6).ReferencedFiles.Item(1).FullFileName
                            
                                        'Compare the file names, if they match change the part list item number for the original to that of the match
                                        If oRefPart = oRefPart2 Then
                                        oPartList.PartsListRows.Item(i3).Item(1).Value = oNumCheck2
                            
                            
                            ''''''''This is where I want it to exit the loop and grab the next original value'''''''
                                        End If
                    
                   
                                'For virtual components get the following comparison values
                                ElseIf oPartList2.PartsListRows.Item(i6).ReferencedFiles.Count = 0 Then
                                           
                                           
                                    oNumCheck2 = oPartList2.PartsListRows.Item(i6).Item(oItem2).Value
                                    oDescripCheck2 = oPartList2.PartsListRows.Item(i6).Item(oDescription2).Value
                                    'Compare the descriptions and if they match change the part list item number for the original to that of the match
                                        If oDescripCheck = oDescripCheck2 Then
                                        oPartList.PartsListRows.Item(i3).Item(1).Value = oNumCheck2
                            
                            
                            ''''''''This is where I want it to exit the loop and grab the next original value'''''''
                                        End If
                 
                                         
                    
                            Else
                   
                            ''''''''This is where if no matches were found I want it to continue going through the comparison loop'''''''
                            End If
                    
                    
                    Next
                    Next
                    Next
                    
               Next
            Next
       Next
        
    'MsgBox ("Matching Numbers has been finished")
End Sub

Answer 1

对于嵌套 for 循环的转义，您可以使用 GoTo 并指定位置。

Sub GoToTest()
    Dim a, b, c As Integer
    
    For a = 0 To 1000 Step 100
        For b = 0 To 100 Step 10
            For c = 0 To 10
                Debug.Print vbTab & b + c
                If b + c = 12 Then
                    GoTo nextValueForA
                End If
            Next
        Next
nextValueForA:
        Debug.Print a + b + c
    Next
End Sub

Answer 2

这里有几个示例演示 (1) 打破（退出）循环和 (2) 在数组中查找值。

可以修改 2 个数组的交集示例以满足您的需要，“创建一个比较循环以通过绘图检查 oRefPart 与其他 BOM 项并查看是否存在匹配项。”请注意，您可能会在 2 个数组之间找到多个匹配项。

Option Explicit
Option Base 0

' Example - break out of loop when condition met.
Public Sub ExitLoopExample()
    Dim i As Integer, j As Integer
    
    ' let's loop 101 times
    For i = 0 To 100:
        j = i * 2
        'Print the current loop number to the Immediate window
        Debug.Print i, j
        ' Let's decide to break out of the loop is some
        ' condition is met.  In this example, we exit
        ' the loop if j>=10.  However, any condition can
        ' be used.
        If j >= 10 Then Exit For
    Next i
End Sub


' Example - break out of inner loop when condition met.
Public Sub ExitLoopExample2()
    Dim i As Integer, j As Integer

    For i = 1 To 5:
        For j = 1 To 5
            Debug.Print i, j
            ' if j >= 2 then, exit the inner loop.
            If j >= 2 Then Exit For
        Next j
    Next i
End Sub


Public Sub FindItemInArrayExample():
' Find variable n in array arr.
    Dim intToFind As Integer
    Dim arrToSearch As Variant
    Dim x, y
    
    intToFind = 4
    arrToSearch = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)

    x = FindItemInArray(FindMe:=intToFind, _
                        ArrayToSearch:=arrToSearch)
    
    If IsEmpty(x) Then
        Debug.Print intToFind; "not found in arrToSearch"
    Else
        Debug.Print "found "; x
    End If
    
    intToFind = 12
    y = FindItemInArray(FindMe:=intToFind, _
                        ArrayToSearch:=arrToSearch)
                        
    If IsEmpty(y) Then
        Debug.Print intToFind; "not found in arrToSearch"
    Else
        Debug.Print "found "; y
    End If
End Sub

Public Function FindItemInArray(FindMe, ArrayToSearch As Variant):
    Dim i As Integer

    For i = LBound(ArrayToSearch) To UBound(ArrayToSearch)
        If FindMe = ArrayToSearch(i) Then
            FindItemInArray = ArrayToSearch(i)
            Exit For
        End If
    Next i

End Function


' Create a comparison loop to go through the drawing that checks
' the oRefPart against other BOM items and see if there is a match.
Public Sub ArrayIntersectionExample():
    Dim exampleArray1 As Variant, exampleArray2 As Variant
    Dim arrIntersect As Variant
    Dim i As Integer
    
    ' Create two sample arrays to compare
    exampleArray1 = Array(1, 2, 3, 4, 5, 6, 7)
    exampleArray2 = Array(2, 4, 6, 8, 10, 12, 14, 16)
    
    ' Call our ArrayIntersect function (defined below)
    arrIntersect = ArrayIntersect(exampleArray1, exampleArray2)
    
    ' Print the results to the Immediate window
    For i = LBound(arrIntersect) To UBound(arrIntersect)
        Debug.Print "match " & i + 1, arrIntersect(i)
    Next i
End Sub

Public Function ArrayIntersect(arr1 As Variant, arr2 As Variant) As Variant:
' Find items that exist in both arr1 and arr2 (intersection).
' Return the intersection as an array (Variant).
    Dim arrOut() As Variant
    Dim matchIndex As Long
    Dim i As Long, j As Long
    
    ' no matches yet
    matchIndex = -1
    ' begin looping through arr1
    For i = LBound(arr1) To UBound(arr1)
        ' sub-loop for arr2 for each item in arr1
        For j = LBound(arr2) To UBound(arr2)
            ' check for match
            If arr1(i) = arr2(j) Then
                ' we found an item in both arrays
                
                ' increment match counter, which we'll
                ' use to size our output array
                matchIndex = matchIndex + 1
                ' resize our output array to fit the
                ' new match
                ReDim Preserve arrOut(matchIndex)
                ' now store the new match our output array
                arrOut(matchIndex) = arr1(i)
            End If
        Next j
    Next i
    ' Have the function return the output array.
    ArrayIntersect = arrOut
End Function