Excel VBA :: Найти функцию в цикле

Question

Я пытаюсь выполнить цикл нескольких листов, содержащих некоторые исходные данные, которые необходимо скопировать на один основной лист, называемый здесь «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 

Answer 1

здесь короткий образец, как использовать метод «Найти», чтобы найти первое вхождение источника. Значение в приоритетеList.

Источник клеток является одним из элементов из серии «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. BTW Если вы хотите найти точную строку с кодовой ошибкой, тогда вы должны прокомментировать On Error Resume Next line .. :) Далее вы можете просто сохранить значения в новый массив, сбрасывать все остальное в основной лист позже после итерации по всем листам вместо того, чтобы идти вперед и назад на листы, код, sheets..code ..

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.

• VBA in find function runtime error 91
• Excel 2007 VBA find function. Trying to find data between two sheets and put it in a third sheet

Я отредактировал исходный код, чтобы включить основную логику с помощью два массива. Поскольку вам нужно ссылаться на значения в столбце исходных текстов 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