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

时间:2021-03-09 21:41:54

标签: vba autodesk-inventor

我正在为我的 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

2 个答案:

答案 0 :(得分:0)

要从嵌套的 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 :(得分:0)

以下是一些示例,用于演示 (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, 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
相关问题