Обновление ячейки с помощью App.Match - быстрее, чем App.VLookup? - PullRequest
1 голос
/ 22 мая 2019

Я пытаюсь найти значение ключа «PR-данные», глядя в «PR-данные Windchill». Найдя, я хотел бы скопировать 6-ю ячейку справа от найденной в "PR Data Windchill" и вставить обратно в исходный ключ в 6-й ячейке справа в "PR-данных".

Я пытался использовать 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

1 Ответ

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

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