Question

我正在尝试在“ PR Data Windchill”中搜索“ PR Data”的键值。找到后，我想将第6个单元格复制到“ PR Data Windchill”中找到的右侧，然后粘贴回“ PR Data”中第6个单元格中的原始键。

我尝试使用Application.VLookup，尽管它可以工作，但是速度很慢。我正在处理的数据范围是50,000-100,000个项目。

Function Update()

Dim Master As Worksheet
Dim Slave As Worksheet
Dim lrS As Long
Dim i As Long, m, SLookup As Range

Set Master = ThisWorkbook.Worksheets("PR Data Windchill")
Set Slave = ThisWorkbook.Worksheets("PR Data")

Set SLookup = ThisWorkbook.Worksheets("PR Data Windchill").Columns(1)

lrS = Slave.Cells(Slave.Rows.Count, "A").End(xlUp).Row

With Slave
    For i = 7 To lrS
        Select Case .Range("G" & i)
        Case Is = "" '"Open", "Under Review", "Accepted"
        m = Application.Match(.Rows(i).Cells(1).Value, SLookup, 0)
        .Rows(i).Cells(1).Offset(0, 6).Copy Slave.Rows(i).Cells(1).Offset(0, 6)
        End Select
    Next i
End With

Application.CutCopyMode = False

MsgBox ("Status Update Complete")

End Function

Answer 1

假设任一工作表的A列中没有空格，并且数据的第一行是第1行...

Function Update()

Dim Master As Worksheet
Dim Slave As Worksheet

Set Master = ThisWorkbook.Worksheets("PR Data Windchill")
Set Slave = ThisWorkbook.Worksheets("PR Data")

Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")

Dim rc As Long
rc = 1
Do Until Master.Cells(rc, 1) = ""
    If Not dict.Exists(Master.Cells(rc, 1).Value) Then dict.Add Master.Cells(rc, 1).Value, Master.Cells(rc, 7).Value
    rc = rc + 1
Loop

rc = 7 'changed from 1
Do Until Slave.Cells(rc, 1) = ""
    If Slave.Cells(rc, 7).Text = "" Then
        If dict.Exists(Slave.Cells(rc, 1).Value) Then Slave.Cells(rc, 7) = dict(Slave.Cells(rc, 1).Value)
    End If
    rc = rc + 1
Loop

MsgBox ("Status Update Complete")

End Function

使用App.Match进行单元更新-比App.VLookup更快吗？

1 个答案: