Страницы: 1
RSS
Внесение формул в таблицу средствами VBA
 
Доброго времени суток всем.

Подскажите, как улучшить процесс работы алгоритма
Есть файл, состоящий из таблицы для внесения данных и таблиц подведения итогов по всем городам и по товарам( таблицы очень большие)
После заполнения данных за месяц по параметрам, через VBA вношу в лист формулы для просчета результатов параметров по городам и товарам.

Для реализации внесения формул использовал массивы(для диапазонов с разными формулами) и range(для диапазонов с одинаковыми формулами). Не радует время обработки данных.
Как лучше реализовывать подобные задачи с минимальным временем обработки данных

Заранее спасибо
 
Лучше не формулы заносить макросом в ячейки, а макросом вычислять, и заносить значения.
 
Цитата
Юрий М написал: макросом вычислять, и заносить значения.
Поясните пожалуйста. Для расчета использую в основном счётеслимн и суммеслимн.
Сделать алгоритм для каждого из них и прогонять через массивы?

Приложил принтскрин таблицы. Желтым выделены все поля где добавляются формулы.

 
Скрин ничего не даёт, кроме того, что формул получается многовато ))  
 
Кстати, пока делал, столкнулся с проблемой что нужно высчитывать Минимальные и Максимальные значения по нескольким условиям.
Первоначально сделал формулой через массив:
{=МИН(ЕСЛИ(B12:B191=B9;BF12:BF191))}

Но из-за того что это было неудобно, написал функцию:
Код
Function MaxIf(TableParam As Range, SearchParam As String, Rezults As Range) As String
'*********************************************************************************
' ***********>< Nahojdenie max znacheniya po usloviyu ><**************
'*********************************************************************************
    Dim mA(), mA2(), i As Long
    mA = TableParam
    mA3 = Rezults
    ReDim mA2(1 To UBound(mA), 1)
    '-----------------------------------
    For i = 1 To UBound(mA)
        If mA(i, 1) = SearchParam Then
            mA2(i, 0) = mA3(i, 1)
        End If
    Next i
    '-----------------------------------
    MaxIf = Format(Application.Max(mA2), "hh:mm:ss") ' Pri zamene .Min na .Max menyaem kriteriy poiska
End Function
 
Надеюсь кому то да пригодится
 
Цитата
DSH написал: Но из-за того что это было неудобно
ну если только поэтому...
а вообще-то дублирование подобных стандартных формул на VBA - однозначное замедление работы всего файла.

по самой функции:
ma2 - лишний массив.
application.max - ненужная функция.
если уж взялись объявлять переменные - то почему не все?
Цитата
DSH написал: Надеюсь кому то да пригодится
думаю - да.
а потом их нужно будет заново переучивать писать правильный код.
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
Цитата
ikki написал: переучивать писать правильный код
Ну с массивами я вообще как неделю познакомился, спасибо вам что направили меня тогда.
А по поводу кода, подправьте меня пожалуйста. Опыт приходит с практикой.
ma2 а как обойтись без него, я нахожу все значения, соответствующие требованию, как мне их записать без использования 3го массива?
Application.max это то что смог придумать как решение. Как можно было сделать по другому?
Касательно  mA3 действительно забыл обьявить :)
Изменено: DSH - 30.07.2015 18:38:51
 
DSH, да в общем-то Ваш код не так уж и плох :)
свою задачу он обычно выполняет.
просто в нём есть немного лишнего.
и (для реальной жизни) не хватает проверок ошибок.

для сравнения - вот такой предварительный вариант:
Код
Function MaxIf(TableParam As Range, SearchParam As String, Rezults As Range)
'*********************************************************************************
' ***********>< Nahojdenie max znacheniya po usloviyu ><**************
'*********************************************************************************
    Dim mA(), mA3(), i As Long, t As Double, f As Boolean
    mA = TableParam.Value
    mA3 = Rezults.Value
    On Error GoTo ex
    '-----------------------------------
    For i = 1 To UBound(mA)
        If mA(i, 1) = SearchParam Then
            If Not f Then
              t = mA3(i, 1): f = True
            ElseIf t < mA3(i, 1).Value Then
              t = mA3(i, 1).Value
            End If
        End If
    Next i
    '-----------------------------------
    If f Then MaxIf = Format(t, "hh:mm:ss"): Exit Function
ex:
    MaxIf = CVErr(xlErrNA)
End Function
но, честно говоря, и он далеко не идеален :)
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
Цитата
Юрий М написал: формул получается многовато ))
Формул действительно много. Не могу понять логику, как должен будет работать код. Обобщенно на примере одной формулы
Код
Sub SchetEsliMn()
    '--------------------------------
    Dim mA(), mA2(), mA3(), mA4()
    Dim i As Long, j As Long
    '--------------------------------
    '=СЧЁТЕСЛИМН(AX$12:AX$10000;"*";$B$12:$B$10000;$B4) 'На примере формулы
    
     mA = [b4:b9].Value        'Перечень товаров
    mA2 = [b12:b10000].Value   'Товары по городам
    mA3 = [ax12:ax10000].Value 'Данные, которые необходимо обработать 
             '[ax4:ax9].Value      'Куда должны сесть результаты
   
    For i = 1 To UBound(mA)
        For j = 1 To UBound(mA2)
           '......................................Обработка данных и определение количества 
        Next j
    Next i
End Sub
Получается что для каждой колонки таблицы нужен будет цикл запускать и в нем прогонять и потом разом закидывать в нужные ячейки, правильно мыслю?
 
Цитата
Юрий М написал: Скрин ничего не даёт
намёков не понимаете? :)
файл с примером будет?
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
ikki, вот до этого я вообще не додумался, брать значение и проверять следующие элементы на больше(меньше) ли его и использовать его.
И вот про проверки надо будет мне почитать :)
 
Цитата
ikki написал: намёков не понимаете?
:)
Прилагаю файл с примером.
Постарался убрать все лишнее, но все равно без архива не обошлось(
Изменено: DSH - 30.07.2015 18:39:50
 
Приветствую всех.
Сделал вариант кода для формулы счётеслимн по столбцам. С коллекцией работаю впервые, может что и некорректно сделал, прошу подправить
Код
Sub SchetEsliMn()
'Формула в коде VBA=СЧЁТЕСЛИМН(AX$12:AX$10000;"*";$B$12:$B$10000;$B4)
    '--------------------------------
    Dim mA(), mA2(), mA3(), mA4()
    Dim i As Long, j As Long, y As Long
    Dim rCntD As New Collection
    '--------------------------------
    mA = [b4:b9].Value: ReDim mA4(1 To UBound(mA), UBound(mA, 2)) 'Perechen tovarov
    mA2 = [b12:b10000].Value   'Tovari po gorodam
    '-------------------------------------------------------------------
    For y = 50 To 171
        mA3 = Range(Cells(12, y), Cells(10000, y)).Value 'massiv rezultatov Kak sdelat ego plavayushim(dinamicheskim???)
    '---------------------------------
        For i = 1 To UBound(mA)      '[b4:b9].Value
            For j = 1 To UBound(mA2) '[b12:b10000].Value
                If mA2(j, 1) = mA(i, 1) Then rCntD.Add (mA3(j, 1)) '[ax12:ax10000].Value
             Next j
             '~~~~~~~~~~~~~~~~~~~~~~~~
             mA4(i, 0) = rCntD.Count: Set rCntD = New Collection
             '~~~~~~~~~~~~~~~~~~~~~~~~
        Next i
        '--------
        Cells(4, y).Resize(UBound(mA4), UBound(mA4, 2)).Value = mA4: y = y + 10
    Next y
    '-------------------------------------------------------------------
End Sub
Как сделать сумму значений из коллекции?
Страницы: 1
Наверх