сделать рутину более эффективной? - PullRequest
Новая
       9

сделать рутину более эффективной?

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

У меня есть этот код, чтобы найти значения, которые принадлежат значению в ячейке C3 (и далее вниз): 

aantalrijen = .Range("A2", .Range("A2").End(xlDown)).Cells.Count
    For I = 2 To aantalrijen + 1
        For J = 108 To 112
            For Each cell In .Range(.Cells(2, J), .Cells(aantalrijen, J)).Cells
                cell.Value = Application.VLookup(.Cells(I, 3), Sheets("omzet").Range("C:DH"), J - 2, 0)
            Next cell
        Next J
    Next I

Я знаю, что это не может быть самым эффективным способом получить желаемый результат. Как мне настроить код, чтобы сделать его наиболее эффективным?

Обновление:

На данный момент я удовлетворен этим результатом: 

aantalrijen = .Range("A2", .Range("A2").End(xlDown)).Cells.Count
    For J = 108 To 112
        For I = 2 To aantalrijen
            .Cells(I, J).Value = Application.VLookup(.Cells(I, 3), Sheets("omzet").Range("C:DH"), J - 2, 0)
        Next I
    Next J

End With

это достаточно быстро для меня сейчас и возвращает желаемые результаты.

1 Ответ

1 голос
/ 15 мая 2019

Здесь: 

Option Explicit
Sub Test()

    Dim arrSource, arrData, i As Long, j As Long, ColI As Long, ColF As Long
    Dim DictMatches As New Scripting.Dictionary
    Dim DictHeaders As New Scripting.Dictionary

    With ThisWorkbook
        arrSource = .Sheets("omzet").UsedRange.Value
        arrData = .Sheets("SheetName").UsedRange.Value 'change this for the worksheet you are working on
    End With

    For i = 1 To UBound(arrSource, 2) 'this will store the headers position
        DictHeaders.Add arrSource(1, i) 'this will throw an error if you have any duplicate headers
    Next i

    For i = 2 To UBound(arrSource) 'this will store the row position for each match
        DictMatches.Add arrSource(i, 3), i 'this will throw an error if you have any duplicates
    Next i

    'Here you can change where you want to evaluate your data
    ColI = 108
    ColF = 112

    For i = 2 To UBound(arrData) 'loop through rows
        For j = ColI To ColF 'loop through columns
            arrData(i, j) = arrSource(DictMatches(arrData(i, 3), DictHeaders(1, j)))
        Next j
    Next i

    'Paste the arrData back to the sheet
    ThisWorkbook.Sheets("SheetName").UsedRange.Value = arrData

End Sub

Это самый быстрый способ, почему?

  1. Вы сохраняете оба листа в массивах, и с этого момента вы работаете только с массивами (что означает работу с памятью, поэтому работа быстрее)
  2. Использование функций Excel всегда замедляет работувместо этого мы храним все значения индекса в строках и заголовках для листа omzet, поэтому, когда вы указываете значение из столбца C на вашем рабочем листе, он дает вам результат, ничего не вычисляя.

Здесь: arrSource(DictMatches(arrData(i, 3), DictHeaders(1, j))) мы даем положение строки и положение столбца.

DictMatches(arrData(i, 3) вернет вам строку, в которой это совпадение было найдено внутри диктитона.DictHeaders(1, j) вернет вам столбец, в котором этот заголовок был найден внутри словаря.

Примечание: для работы словарей необходимо, чтобы библиотека Microsoft Scripting Runtime проверила ссылки.Также словари Case Sensitive, поэтому Hello <> hello.

...