Индексирование по строке в столбце и поиск частичных совпадений в строке

Question

У меня возникли проблемы при разработке цикла for, который включает функцию частичного соответствия.

Чтобы решить проблему:

У меня есть два листа, которые будут сравниваться - один существует в столбце sheet1 b, а другой столбец sheet2 c.

Цикл for будет перебирать столбец B на Sheet1, а затем извлекать текущую строку в каждой строке - эта текущая строка затем передается Я попытался vlookup и сравнил с ВСЕМ столбцом C на листе 2, чтобы найти совпадение: если есть совпадение, он возвращает столбец ADJACENT справа от столбца C и затем помещает это значение в столбец ADJACENT справа от столбца B.

В настоящее время я пытался реализовать оператор for, который выполняет итерацию по столбцу b, и если текущая строка столбца B равна Vlookup столбца C для совпадения с текущей строкой, тогда вернуть значение.

Sub JoinGroupOnPN()
Dim PartGroupSheet As Worksheet
Dim OEEPartSheet As Worksheet    
Dim OEERowRange As Long    
Dim OEEColumnRange As Long    
Dim PGRowRange As Long    
Dim PGColumnRange As Long    
Dim OEEArray As Variant    
Dim PGArray As Variant    
Dim i As Long, j As Long

Set PartGroupSheet = ActiveWorkbook.Worksheets("PartGroup")    
Set OEEPartSheet = ActiveWorkbook.Worksheets("OEE Report")    
OEERowRange = OEEPartSheet.Cells(Rows.Count, 1).End(xlUp).Row    
OEEColumnRange = OEEPartSheet.Cells(1,Columns.Count).End(xlToLeft).Row    
PGRowRange = PartGroupSheet.Cells(Columns.Count, 1).End(xlUp).Row    
PGColumnRange = PartGroupSheet.Cells(1,Columns.Count).End(xlToLeft).Row
ReDim OEEArray(OEERowRange, OEEColumnRange)    
ReDim PGArray(PGRowRange, PGColumnRange)    
Dim StringToMatch As String    
Dim MatchingString As String

For i = 2 To OEERowRange
StringToMatch = OEEPartSheet.Cells(i, 1).Text
MatchingString = Application.WorksheetFunction.VLookup(Arg1:=StringToMatch, Arg2:=PartGroupSheet.Range(Cell1:=2, Cell2:=1), Arg3:=2, Arg4:=True)

    For j = 2 To PGRowRange

        If StringToMatch = MatchingString Then

            Debug.Print StringToMatch

        End If
    Next j
Next i

End Sub

Я получаю сообщение об ошибке, в котором говорится, что объект диапазона потерпел неудачу, и я пытался преобразовать его в тип диапазона, но ошибка все та же.

Ошибка происходит в

MatchingString = Application.WorksheetFunction.VLookup(Arg1:=StringToMatch, Arg2:=PartGroupSheet.Range(Cell1:=2, Cell2:=1), Arg3:=2, Arg4:=True)

и сообщение об ошибке: «Метод» диапазона «Object'_WorkSheet Failed»

Я пока не могу опубликовать фотографии

Лист 1 Лист 2

Любая помощь будет признательна, спасибо !!

Answer 1

Примерно так должно работать:

Sub JoinGroupOnPN()
    Dim PartGroupSheet As Worksheet
    Dim v, c As Range, rngSrch As Range

    Set PartGroupSheet = ActiveWorkbook.Worksheets("PartGroup")

    With ActiveWorkbook.Worksheets("OEE Report")
        Set rngSrch = .Range(.Range("B2"), .Cells(.Rows.Count, "B").End(xlUp))
    End With

    For Each c In rngSrch.Cells
        If Len(c.Value) > 0 Then
            'do not use WorksheetFunction here
            v = Application.VLookup(c.Value, PartGroupSheet.Range("B:C"), 2, False)
            c.Offset(0, 1).Value = IIf(IsError(v), "No match", v)
        End If
    Next c
End Sub