0

我正在为我的 CAD 程序创建一个第三方插件，其中有一个子插件，它通过绘图并找到所有部件列表 (BOMS)，如果部件列表中的任何项目在 BOM 之间共享（正在使用的一个部件例如，在 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。当我运行我的按钮时，因为一旦找到它，我就无法让它离开比较循环匹配所有 X 部分最终从 BOM 3 获得项目编号 7，因为它是最后一个实例。（我可以通过向后逐步执行我的 for 循环来完成我想做的事情，因此所有事情最终都成为最常见的事件，但我想让我的出口工作正常，因为它可以节省我不必要的比较）

如何使用 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
4

2 回答 2

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
于 2021-03-10T16:47:30.393 回答
0

这里有几个示例演示 (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
于 2021-03-10T19:35:43.150 回答