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

Question

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

非常感谢您的回答！

帕特里克

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

Answer 1

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

源单元格是“G4:G73”范围内的单元格之一，而“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

Answer 2

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

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

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

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

Answer 3

对于可能感兴趣的每个人，这是我最终使用的代码版本（与 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