Question

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

非常感谢您的回答！

帕特里克

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 用于“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行.. :)此外，你可以简单地将值存储到一个新数组中，在迭代后将所有其他内容转储到主表中通过所有的床单，而不是来回往床单，代码，床单..代码..

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的解决方案。

我编辑了初始代码，使用两个数组包含主逻辑。由于您需要引用源表的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

Excel VBA ::循环查找函数

3 个答案: