Excel VBA :: Find循环中的函数
我试图通过几个工作表，包含一些源数据，必须被复制到一个主表，这里称为“PriorityList”。 首先，该子不工作，我认为这个错误是在“ find ”方法中的某个地方。 其次，这个子文件需要很长的时间才能运行，我想这可能是因为“查找”方法search整个表格而不是相关的范围？
非常感谢您的回答！
帕特里克
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 这里简单介绍如何使用“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
这是一个使用arrays的方法。 将每个范围保存到数组中，然后遍历数组以满足if-else条件。 顺便说一句如果你想find具有代码错误的确切的行，那么你必须评论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的机器前面试一试。 所以把上面的代码作为未经testing的代码。 出于同样的原因，我无法运行你的find方法。 但似乎很奇怪。 不要忘记使用match或find做适当的error handling很重要。 尝试检查[在这里find基于解决scheme。
- VBA在查找函数运行时错误91
- Excel 2007 VBA查找function。 试图在两张纸之间find数据，并把它放在第三张纸上
我编辑了最初的代码，包括使用两个数组的主逻辑。 由于您需要引用源列表的J列中的值，因此需要将源数组调整为二维数组。 因此，您可以使用第一列进行validation，然后根据需要检索数据。
对于每个人也许感兴趣，这是我最终使用的代码版本（非常类似于丹尼尔Dusekbuild议的版本）：
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