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

问题描述

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

我有 3 个 BOM，每个 BOM 共享第 X 部分，在 BOM 1 中编号为 1，在 BOM 2 中编号为 4，在 BOM 3 中编号为 7。当我运行我的按钮时，因为一旦它我无法让它离开比较循环发现它首先匹配所有 X 部分，最终从 BOM 3 中获得项目编号 7，因为它是最后一个实例。 （我可以通过向后逐步执行我的 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

解决方法

要从嵌套的 for 循环中转义，您可以使用 GoTo 并指定 where。

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

,

以下是一些示例，用于演示 (1) 跳出（退出）循环和 (2) 在数组中查找值。

可以修改 2 个数组的交集示例以满足您的需求，即“创建一个比较循环来遍历绘图，根据其他 BOM 项目检查 oRefPart 并查看是否存在匹配。”请注意，您可能会在 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,7)
    exampleArray2 = Array(2,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