Зараз обговорюють

"Тобто є ряд завдань, які взагалі без рекурсії не наважуються."  - це як розуміти? Перефразуй, будь ласка. 

виправив, йшлося про те що деякі завдання можна вирішити лише при використанні рекурсії

Спасибі дуже корисна стаття

А ще щось планується подібного найближчим часом?


Дякую за підтримку, радий що Вам сподобалось!

Так маю вже майже дороблений проект по управлінні Audio файлом, на заміну стандартним клавішам управління HTML5, але ще не встиг відтестувати програвання файлів з інтернету, поки лише локально працює

Надіюсь найближчим часом дороблю й закину

Рахунки

webmoneyeur - E385818210641
usd - Z304643423050
uah - U354026817492
rub - R301704373231easypay80002677bitcoin1F5HRGroUtEQW9HBNbeew8iKh5KQ8vJxzw

Зворотній зв'язок

Для покращення роботи сайту надсилайте свої зауваження:
mailЗауваження
mailПропозиція

Статистика

UkrNET - поисково-информационный ресурс

VBA : Як оптимізувати код для перебору даних...

При роботі з великими вибірками даних ми часто стикаємось з проблемою великих затрат часу на виконання певного коду! Тож розглянемо як можна пришвидшити код для економії часу.

Для прикладу візьмемо таке завдання - наявні 2 аркуші з стовцями даних, на першому аркуші потрібно порахувати скільки разів значення з першого аркуша повторюється на другому!

Ви напевне подумали, а що ж тут складного адже в Excel є функція Countif

- так є, але для вибірок в 1048575 значень при розрахунку вбудованою функцією Countif, через 20хв очікувань довелось просто зупинити процес не дочекавшись навіть 5% виконання!

Отже, для виконання завдання нам необхідно буде:

- відсортувати дані, суттєво зменшує затрати часу на виконання

- створити змінну яка буде відсікати вже перевірену частину даних з другого аркуші (зменшуємо кількість ітерацій)

- перевіряти дані доки не отримаємо більше значення з другого аркуша від потрібного(зменшуємо кількість ітерацій)

Дані заповнюємо в масив та перебираємо за допомогою циклу.

В результаті отримуємо наступний код:

Sub Test()
Dim sTime As Variant, eTime As Variant
Dim dataRow1 As Object, dataRow2 As Object
Dim maxRow As Long, i As Long, startPosition As Long
sTime = Time
    maxRow = 1048576
    For i = 1 To 2
        'наповнюємо аркуш випадковими даними в відповідному діапазоні'
        ThisWorkbook.Sheets(i).Range("A2:A" & maxRow).Formula = "=RANDBETWEEN(100000,200000)"
        ThisWorkbook.Sheets(i).Calculate
        ThisWorkbook.Sheets(i).Range("A2:A" & maxRow).Copy
        ThisWorkbook.Sheets(i).Range("A2:A" & maxRow).PasteSpecial Paste:=xlValues
        If i = 1 Then ThisWorkbook.Sheets(i).Range("B2:B" & maxRow).ClearContents
        'очищуємо фільтр'
        ThisWorkbook.Sheets(i).Sort.SortFields.Clear
        'сортуємо дані по зростанню'
        ThisWorkbook.Sheets(i).Sort.SortFields.Add Key:=Range("A1:A" & maxRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ThisWorkbook.Sheets(i).Sort
            .SetRange Range("A1:A" & maxRow): .Header = xlYes: .MatchCase = False: .Orientation = xlTopToBottom: .SortMethod = xlPinYin: .Apply
        End With
    Next i
    'наповнюємо масив даних з першого аркуша'
    Set dataRow1 = Range(ThisWorkbook.Sheets(1).Range("A2"), ThisWorkbook.Sheets(1).Range("B" & maxRow))
    'наповнюємо масив даних з другого аркуша'
    Set dataRow2 = Range(ThisWorkbook.Sheets(2).Range("A2"), ThisWorkbook.Sheets(2).Range("A" & maxRow))
    'встановлюємо нижню межу для перебору значень другого аркуша'
    startPosition = 1
    'верхня межа = maxRow - 1 так як в масиві є всього 1048575 значень'
    For i = 1 To maxRow - 1
        'якщо значення вже перевірялось на попередньому кроці тоді беремо попередньо отриманий результат'
        If dataRow1(i, 1) = dataRow1(i - 1, 1) Then
            dataRow1(i, 2) = dataRow1(i - 1, 2)
        Else
        'якщо значення ще не перевірялось тоді проходимо цикл для підбиття к-ті повторювальних значень'
            For j = startPosition To maxRow - 1
                If dataRow1(i, 1) = dataRow2(j, 1) Then
                    'якщо знайдено збіг тоді збільшуємо значення на +1 (в кол.В)'
                    dataRow1(i, 2) = dataRow1(i, 2) + 1
                ElseIf dataRow1(i, 1) < dataRow2(j, 1) Then
                    'якщо значення другого аркуша більше ніж потрібно тоді встановлюємо початкову позицію на цьому j та виходимо з циклу'
                    startPosition = j
                    Exit For
                End If
            Next j
        End If
        'якщо значення не повторюється на другому аркуші тоді проставити 0'
        If dataRow1(i, 2) = "" Then dataRow1(i, 2) = 0
    Next i
    Set dataRow1 = Nothing
    Set dataRow2 = Nothing
eTime = Time
MsgBox "Обчислено кількість повторень! Час виконання: " & Format(eTime - sTime, "h:mm:ss"), vbInformation + vbOKOnly, ""
End Sub 

Як результат ми отримаємо к-ть повторюваних значень витративши всього 1хв 15с (в залежності від системного обладнання час виконання може дещо відрізнятись)

Отже нам вдалось пришвидшити виконання даного завдання в 10-ки разів!

Примітка: якщо Вам необхідно щоб дані були в тому ж порядку в якому вони заповнені, то Ви можете перед початком роботи пронумерувати їх в додатковій колонці і після виконання коду відсортувати до початкового вигляду!

Завантажити файл з прикладом:

Завантажити з Завантажити з


view292like1dislike0 avatard_l4w clock 2016-09-06 01:57

Коментарі:



Для даної статті відсутні коментарі

Про нас

"Programmers World" розроблено з метою полегшення в освоєнні навичок програмування, та поширення матеріалів з сфери ІТ Українською мовою.

Кожен бажаючий може безкоштовно користуватися ресурсами сайту, щоб:

- Вивчати теоретичні аспекти мов програмування

- Переглядати практичне застосування теорії при виконанні різних міні проектів з відкритим кодом

- Розміщати свої завдання на форумі для допомоги в їх реалізації, або готового коду який може бути корисний іншим користувачам

- Спілкуватись з іншими користувачами та обмінюватись досвідом

Сайт функціонує на безопланій основі та ентузіазмі розробника, якщо Ви бажаєте долучитись до розвитку даного проекту то можете пожертвувати кошти на рахунки розміщені в блоці "Допомога сайту".

Сайт

Зареєстровані користувачі можуть скористатися системою діалогів, в профілі користувача, для отримання потрібної інформації. Написати!

Також Ви можете використати форми відправки Зауважень та Пропозицій.


Електронна пошта

Ви можете звертатись на нашу поштову скриньку site.programmersworld@gmail.com

www.000webhost.com