Excel VBA :: 在循环中查找函数

Excel VBA :: Find function in loop

提问by Patrick

I'm trying to loop through several worksheets that contain some source data that has to be copied to one main sheet, called "PriorityList" here. First of all, the sub is not working and I think the error is somewhere in the "find"-method. Second, the sub takes quite long to run, and I think this is maybe because the "find"-method searches through the whole sheet instead of only the relevant range?

我正在尝试遍历包含一些源数据的几个工作表，这些数据必须复制到一个主工作表中，此处称为“PriorityList”。首先，sub 不工作，我认为错误出在“ find”方法的某个地方。其次，sub 需要很长时间才能运行，我认为这可能是因为“查找”方法搜索整个工作表而不是仅搜索相关范围？

Thank you very much for your answers!

非常感谢您的回答！

Patrick

帕特里克

Sub PriorityCheck()
'Sub module to actualise the PriorityList

Dim CurrWS As Long, StartWS As Long, EndWS As Long, ScheduleWS As Long
StartWS = Sheets("H_HS").Index
EndWS = Sheets("E_2").Index

Dim SourceCell As Range, Destcell As Range

For CurrWS = StartWS To EndWS

    For Each SourceCell In Worksheets(CurrWS).Range("G4:G73")

        On Error Resume Next

        'Use of the find method
        Set Destcell = Worksheets(CurrWS).Cells.Find(What:=SourceCell.Value, After:=Worksheets("PriorityList").Range("A1"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

        'Copying relevant data from source sheet to main sheet
        If Destcell <> Nothing Then
            Destcell.Offset(0, 2).Value = SourceCell.Offset(0, 5).Value + Destcell.Offset(0, 2).Value
            If SourceCell.Offset(0, 3).Value = "x" Then Destcell.Offset(0, 3).Value = "x"
            End If
        End If

        On Error GoTo 0

    Next SourceCell

Next CurrWS

End Sub

回答by dee

here short sample how to use 'Find' method to find the first occurrence of the source.Value in the priorityList.

这里是如何使用 'Find' 方法在 priorityList 中找到第一次出现的 source.Value 的简短示例。

Source cellis one of the cells from the range "G4:G73"and priorityListis used range on "PriorityList"sheet. Hope this helps.

源小区是从范围中的小区中的一个“G4：G73”和priorityList是使用范围“PriorityList”片材。希望这可以帮助。

Public Sub PriorityCheck()
    Dim source As Range
    Dim priorityList As Range
    Dim result As Range

    Set priorityList = Worksheets("PriorityList").UsedRange

    Dim i As Long
    For i = Worksheets("H_HS").Index To Worksheets("E_2").Index
        For Each source In Worksheets(i).Range("G4:G73")
            Set result = priorityList.Find(What:=source.Value)
            If (Not result Is Nothing) Then
                ' do stuff with result here ...
                Debug.Print result.Worksheet.Name & ", " & result.Address
            End If
        Next source
    Next i
End Sub

回答by bonCodigo

Here is an approach using arrays. You save each range into an array, then iterate through array to satisfy your if-else condition. BTW IF you want to find the exact line with code error, then you must comment On Error Resume Nextline.. :) Further, you can simply store the values into a new array, dump everything else into the main sheet later after iterating through all the sheets instead of going back and forth to sheets, code, sheets..code..

这是一种使用arrays. 您将每个范围保存到一个数组中，然后遍历数组以满足您的 if-else 条件。顺便说一句，如果您想找到代码错误的确切行，那么您必须注释On Error Resume Next行.. :) 此外，您可以简单地将值存储到一个新数组中，稍后在遍历所有工作表后将其他所有内容转储到主工作表中来回切换到工作表、代码、工作表......代码......

Dim sourceArray as Variant, priorityArray as Variant
'-- specify the correct priority List range here
'-- if multi-column then use following method
priorityArray = Worksheets(CurrWS).Range("A1:B10").Value
'-- if single column use this method
' priorityArray = WorkSheetFunction.Transpose(Worksheets(CurrWS).Range("A1:A10").Value)

For CurrWS = StartWS To EndWS
   On Error Resume Next    
   sourceArray = Worksheets(CurrWS).Range("G4:J73").Value
   For i = Lbound(sourceArray,1) to UBound(sourceArray,1)
     For j = Lbound(priorityArray,1) to UBound(priorityArray,1)
        If Not IsEmpty(vArr(i,1)) Then    '-- use first column
        '-- do your validations here..
        '-- offset(0,3) refers to J column from G column, that means
        '---- sourceArray(i,3)...
        '-- you can either choose to update priority List sheet here or
        '---- you may copy data into a new array which is same size as priorityArray
        '------ as you deem..
        End If
     Next j
   Next i       
Next CurrWS

PS: Not front of a MS Excel installed machine to try this out. So treat above as a code un-tested. For the same reason I couldn't run your findmethod. But it seems odd. Don't forget when using matchor findit's important to do proper error handling. Try checking out [findbased solutions provided here.

PS：不要在安装了 MS Excel 的机器前尝试一下。因此，将以上视为未经测试的代码。出于同样的原因，我无法运行您的find方法。但这似乎很奇怪。使用时不要忘记，match否则find进行正确的错误处理很重要。尝试查看find此处提供的基于[的解决方案 。

• VBA in find function runtime error 91
• Excel 2007 VBA find function. Trying to find data between two sheets and put it in a third sheet

• 查找函数运行时错误 91 中的 VBA
• Excel 2007 VBA 查找功能。尝试在两张纸之间查找数据并将其放入第三张纸中

I have edited the initial code to include the main logic using two array. Since you need to refer to values in Jcolumn of source sheets, you will need to adjust source array into a two-dimensional array. So you can do the validations using first column and then retrieve data as you desire.

我已经编辑了初始代码以包含使用两个数组的主要逻辑。由于需要引用J源表列中的值，因此需要将源数组调整为二维数组。因此，您可以使用第一列进行验证，然后根据需要检索数据。

回答by Patrick

For everyone maybe interested, this is the code version that I finally used (pretty similar to the version suggested by Daniel Dusek):

对于可能感兴趣的每个人，这是我最终使用的代码版本（与 Daniel Dusek 建议的版本非常相似）：

Sub PriorityCheck()
    Dim Source As Range
    Dim PriorityList As Range
    Dim Dest As Range

    Set PriorityList = Worksheets("PriorityList").UsedRange

    Dim i As Long

    For i = Worksheets("H_HS").Index To Worksheets("S_14").Index
        For Each Source In Worksheets(i).Range("G4:G73")
        If Source <> "" Then
            Set Dest = PriorityList.Find(What:=Source.Value)
            If Not Dest Is Nothing Then
                If Dest <> "" Then
                    Dest.Offset(0, 2).ClearContents
                    Dest.Offset(0, 2).Value = Source.Offset(0, 5).Value + Dest.Offset(0, 2).Value
                End If
            If Source.Offset(0, 3).Value = "x" Then Dest.Offset(0, 3).Value = "x"
                Debug.Print Dest.Worksheet.Name & ", " & Dest.Address
            End If
        End If
        Next Source
    Next i

    MsgBox "Update Priority List completed!"

End Sub