Question

我目前在2个工作表中有一个相当大的数据集，每个工作表中约有59000行。

我需要从工作表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

电流输出： all part numbers are the same

问题似乎出在Set partNumber = wsEam.Range("L:L").Find(What:=rng1.Value, LookIn:=xlValues, lookat:=xlWhole)部分，因为rowCounterPartNumber在E或L列中没有增加。我认为是由于这些是在循环外部定义的

Answer 1

尝试一下：

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

具有“查找”功能的循环

1 个答案: