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