Для цикла с функцией «Найти» - PullRequest
0 голосов
/ 28 мая 2019

В настоящее время у меня достаточно большой набор данных на 2 листах, около 59 тыс. Строк в каждом.

Мне нужно взять номер детали из листа 1, определенный как «wsBomb», и сравнить его с листом 2, определенным как «wsEam». Если у вас есть это, есть смещение 8, чтобы получить номер поставщика и скопировать его обратно в "wsBomb".

У меня есть этот процесс, работающий для первой части данных, однако я изо всех сил пытаюсь заставить это работать в цикле.

Любая помощь будет оценена.

Редактировать Еще раз спасибо за постоянную помощь, функция findnext теперь реализовала цикл и выполняет цикл и изменяет номер детали по мере необходимости. Однако это только ссылка на ячейку L2, а не увеличение, новый код приведен ниже:

    Sub Macro1()

Set wbTrying = Workbooks("RME EAM")
Set wsBomb = wbTrying.Worksheets("Bomb")
Set wsEam = wbTrying.Worksheets("EAM")

rowCounterPartNumber = 2

Set wf = Application.WorksheetFunction

Set rng1 = wsBomb.Range("E" & rowCounterPartNumber)
filterStr = wf.Transpose(rng1)

Dim partNumber As Range
Set partNumber = wsEam.Range("L:L").Find(What:=rng1.Value, LookIn:=xlValues, lookat:=xlWhole)
Dim partNo

For Each partNo In partNumber
    If Not partNo Is Nothing Then

        Do
        wsBomb.Range("D" & rowCounterPartNumber).Value = partNumber.Offset(, -8)
        rowCounterPartNumber = rowCounterPartNumber + 1
        Set partNumber = wsEam.Range("L2:L60000").FindNext(partNumber)

            If partNo Is Nothing Then
            GoTo finished

            End If
            Loop While partNo <> ""
    End If

finished:

Next

End Sub

Токовый выход: все номера деталей одинаковы

Кажется, проблема в разделе Set partNumber = wsEam.Range("L:L").Find(What:=rng1.Value, LookIn:=xlValues, lookat:=xlWhole), поскольку rowCounterPartNumber не увеличивается для столбца E или L. Я думаю, это связано с тем, что они определены вне цикла

1 Ответ

0 голосов
/ 28 мая 2019

Попробуйте это:

Sub Macro1()

Set wbTrying = Workbooks("RME EAM")
Set wsBomb = wbTrying.Worksheets("Bomb")
Set wsEam = wbTrying.Worksheets("EAM")

Dim s As String
rowCounterPartNumber = 2

Set wf = Application.WorksheetFunction

Set rng1 = wsBomb.Range("E" & rowCounterPartNumber)
filterStr = wf.Transpose(rng1)

Dim partNumber As Range
Set partNumber = wsEam.Range("L:L").Find(What:=rng1.Value, LookIn:=xlValues, lookat:=xlWhole)

If Not partNumber Is Nothing Then 'if found
    s = partNumber.Address        'store address of first found cell
    Do
        wsBomb.Range("D" & rowCounterPartNumber).Value = partNumber.Offset(, -8)
        rowCounterPartNumber = rowCounterPartNumber + 1
        Set partNumber = wsEam.Range("L:L").FindNext(partNumber)
    Loop Until partNumber.Address = s  'repeat until back to first found cell
End If

End Sub
...