1

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

非常感谢您的回答！

帕特里克

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
4

3 回答 3

3

这里简短的示例如何使用“查找”方法在 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
于 2013-02-17T20:45:29.460 回答
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源表列中的值，因此您需要将源数组调整为二维数组。因此，您可以使用第一列进行验证，然后根据需要检索数据。

于 2013-02-17T13:38:56.310 回答
0

对于大家可能感兴趣，这是我最终使用的代码版本（与 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
于 2013-02-19T14:13:15.290 回答