Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 3 След.
Выполнение процедур по таймеру
 
Приветствую всех. Вчера сидел пробовал разного варианты и нашел выход.
Как указал Dima S,  нужно было использовать WAIT чтобы сделать паузу.

Цель была сделать код, который будет выполнятся автоматически и поэтапно, с указанным мною интервалом времени. Что то вроде поэтапного решения задачи, по пунктно. a+b=c. Просмотрел значение, далее с+d=f. Просмотрел результаты и т.д.
Код
Sub PtimerSchet()
    Dim mA()
    mA = Лист5.Range("A2:B51").Value
    For i = 1 To 52
        If mA(i, 1) = pNum Then
            pTime = TimeValue("0:00:0" & mA(i, 2))
            DoEvents
             Application.Wait Now + pTime ' ЗАМЕНИЛ НА WAIT И ДОСТИГ НУЖНОГО МНЕ РЕЗУЛЬТАТА
            Exit For
        End If
    Next i
End Sub
Спасибо за помощь Всем!
Выполнение процедур по таймеру
 
Доброго времени суток Всем.
Прошу направить в решении идеи. Суть ее заключается в том, чтобы выполнять ряд ghjwtleh по указанному времени. Задачу разбил на блоки.
1. Создал таблицу, в которой под нумерацию указал численное значение для задержки выполнения макроса.
2. Создал процедуру, в котором указываю, какой временной промежуток брать из таблицы 1
Public pNum As Long
Код
public pNum as Long 'Порядковый номер в таблице с нужным временем задержки
Sub listAnalisys()
    pNum = 1 'Порядковый номер в таблице с нужным временем задержки
    PtimerSchet ' Запуск таймера
    EffEng ' Выполнение нужной процедуры
    pNum = 2 'Порядковый номер в таблице с нужным временем задержки
    PtimerSchet ' Запуск таймера
    EffRus ' Выполнение нужной процедуры
    pNum = 3 'Порядковый номер в таблице с нужным временем задержки
    PtimerSchet ' Запуск таймера
    EffAll ' Выполнение нужной процедуры
    pNum = 4 'Порядковый номер в таблице с нужным временем задержки
    PtimerSchet ' Запуск таймера
    Total ' Выполнение нужной процедуры
End Sub
3. Создал таймер, который должен через массив находить время задержки кода, и выполнять код
Код
Public pTime As Date
Sub PtimerSchet() 'Таймер
    Dim mA()
    mA = Лист5.Range("A2:B51").Value 'таблица с указанием номера и времени задержки срабатывания процедуры
    For i = 1 To 52  
        If mA(i, 1) = pNum Then 'Перебираем массив чтобы найти нужное время задержки 
            pTime = TimeValue("0:00:0" & mA(i, 2)) 
            schetchik
            Exit For
        End If
    Next i
End Sub
'------------------------------------------------------------------------
Sub schetchik()
Application.ScreenUpdating = False
        pTime = pTime - TimeValue("0:00:01")
   If pTime > 0 Then 
        Application.OnTime Now + TimeValue("00:00:01"), "schetchik" ' Выполняем перезапуск процедуры с задержкой в 1 сек
    Else
        Application.ScreenUpdating = True
        Exit Sub 'В момент когда pTime будет равен 0, завершаем процедуру
    End If
End Sub

Но нужного результата никак не могу достигнуть, задержки не происходит во время выполнения кода. Укажите пожалуйста направление. Заранее благодарю за помощь
Обращение к именам книг содержащих в названии '
 
justirus, Спасибо большое.  :D Иногда самое простое решение является самым эффективным)))
Обращение к именам книг содержащих в названии '
 
Доброго времени суток всем.
Подскажите пожалуйста когда я программно обращаюсь к файлам excel бывают случаи когда в названии документов есть символы '
И в таких случаях идет сбой обработки.
Вот пример обращения:
VLOOKUP(RC7,'[" & wb1.Name & "]Лист1'!C7:C200,5,0)

Допустим: "Мой файл1.xls" и любые другие без проблем.
Но когда в названии есть "Мой файл'1.xls" приходится мучаться. Именно этот символ меня достает.

Как выходить из ситуации.
Спасибо заранее
Внесение формул в таблицу средствами VBA
 
Приветствую всех.
Сделал вариант кода для формулы счётеслимн по столбцам. С коллекцией работаю впервые, может что и некорректно сделал, прошу подправить
Код
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
Как сделать сумму значений из коллекции?
Внесение формул в таблицу средствами VBA
 
Цитата
ikki написал: намёков не понимаете?
:)
Прилагаю файл с примером.
Постарался убрать все лишнее, но все равно без архива не обошлось(
Изменено: DSH - 30 Июл 2015 18:39:50
Внесение формул в таблицу средствами VBA
 
ikki, вот до этого я вообще не додумался, брать значение и проверять следующие элементы на больше(меньше) ли его и использовать его.
И вот про проверки надо будет мне почитать :)
Внесение формул в таблицу средствами 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
Получается что для каждой колонки таблицы нужен будет цикл запускать и в нем прогонять и потом разом закидывать в нужные ячейки, правильно мыслю?
Внесение формул в таблицу средствами VBA
 
Цитата
ikki написал: переучивать писать правильный код
Ну с массивами я вообще как неделю познакомился, спасибо вам что направили меня тогда.
А по поводу кода, подправьте меня пожалуйста. Опыт приходит с практикой.
ma2 а как обойтись без него, я нахожу все значения, соответствующие требованию, как мне их записать без использования 3го массива?
Application.max это то что смог придумать как решение. Как можно было сделать по другому?
Касательно  mA3 действительно забыл обьявить :)
Изменено: DSH - 30 Июл 2015 18:38:51
Внесение формул в таблицу средствами VBA
 
Кстати, пока делал, столкнулся с проблемой что нужно высчитывать Минимальные и Максимальные значения по нескольким условиям.
Первоначально сделал формулой через массив:
{=МИН(ЕСЛИ(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
 
Надеюсь кому то да пригодится
Внесение формул в таблицу средствами VBA
 
Цитата
Юрий М написал: макросом вычислять, и заносить значения.
Поясните пожалуйста. Для расчета использую в основном счётеслимн и суммеслимн.
Сделать алгоритм для каждого из них и прогонять через массивы?

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

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

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

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

Заранее спасибо
Оптимизация многоуровневых циклов
 
Цитата
ikki написал: будет чего непонятно - спрашивайте.
Ок,спасибо. Разберу по порядку от массивов к словарям.
Оптимизация многоуровневых циклов
 
Слэн, спасибо за комментарии. Осведомлен, значит вооружен ;)
Оптимизация многоуровневых циклов
 
ikki, спасибо большое за помощь и за готовое решение. Скорость обработки значительно выше( добавил еще строк) .
Еще бы понять логику обработки)) Спасибо большое вам!!!
Оптимизация многоуровневых циклов
 
JeyCi, спасибо за направление. Буду пробовать сделать обработку в массиве.

Да, согласен что не охватил всех пунктов.
1. В диапазоне "С4:С9" делается пометка если необходимо исключить данные позиции из расчета.
2. Чтобы исключить данные позиции из таблицы товара в колонке С делаются пометки, какие позиции исключать( в примере просто ВПРом)
3. В диапазоне "D3:K3" делаются пометки если необходимо убрать план с отпределенных дней.

При обработке алгоритма циклом прогоняю каждую ячейку в "D3:K3"(3)  на поиск пометки. Если ее нет, то тогда Прогоняю по строкам, колонка С (2), проверку на наличии пометок. В таблицу Результатов переносятся только те ячейки, на которых нет пометок.
В итогах, принцип индентичен, только проверка по диапазону "С4:С9" (1)
Изменено: DSH - 16 Июл 2015 09:17:25
Оптимизация многоуровневых циклов
 
Jeyci, так в примере и табличка маленькая. В оригинальном файле, более 5000 строк и около 100 столбцов. И время обработки уже около 20 сек
Оптимизация многоуровневых циклов
 
Доброго времени суток всем.
Подскажите варианты оптимизации кода для ускорения процесса обработки данных. Суть в следующем, в листе есть таблица товара, порядка 5000 строк и таблица итогов, 12 строк. Задача состоит в том чтобы копировать данные из таблицы план в соответствующие колонки по нескольким условиям. Код отрабатывает, но время обработки кода очень большое. Приложил файл с примером кода.
Заранее спасибо за помощь!
Многоуровневый поиск и вывод результатов, Поиск внутри поиска и вывод результатов
 
То что ерунда, проверил на практике.
В принципе подход с 2мя библиотеками оптимален для данной задачи, поэтому не буду усложнять жизнь))
Все равно спасибо, за вариант решения.
Многоуровневый поиск и вывод результатов, Поиск внутри поиска и вывод результатов
 
Спасибо за разъяснения.
HUGO, получается  что в одной библиотеке можно сделать так:
Код
d.item(t) =Cells(i, 7) & " " & Cells(i, 8) & " " &................ & " " &  d.item(t) + .Cells(i, 4)
Изменено: DSH - 26 Фев 2015 10:07:16
Многоуровневый поиск и вывод результатов, Поиск внутри поиска и вывод результатов
 
Ок, спасибо за наставления, обязательно почитаю.

Цитата
возможно, для этих целей лучше сформировать d2 (т.е. 2-й словарь) ...
А для чего, ведь его задача одна, именно подсчитать сумму. На ум пришел такой выход, чтобы избежать многих библиотек.
Код
Set d = CreateObject("Scripting.Dictionary"): d.comparemode = 1
         Set m = CreateObject("Scripting.Dictionary"): m.comparemode = 1
 ......................
     d.item(t) = d.item(t) + .Cells(i, 4)
        m.item(t) = .Cells(i, 7) & " " & .Cells(i, 8)  & " " & . ..... n
...............
For Each k In d.keys
      kVal=split(m.item(k)," ")
msg "1= " & kVal(0) & "2= " & kVal(1).......
    Next

Изменено: DSH - 26 Фев 2015 09:34:54
Многоуровневый поиск и вывод результатов, Поиск внутри поиска и вывод результатов
 
Подскажите, если мне нужно обрабатывать еще значения в таблице, то для каждого нужно будет создавать отдельную библиотеку
Код
Set d = CreateObject("Scripting.Dictionary"): d.comparemode = 1
    Set f = CreateObject("Scripting.Dictionary"): f.comparemode = 1
     Set m = CreateObject("Scripting.Dictionary"): m.comparemode = 1
 ......................
     d.item(t) = d.item(t) + .Cells(i, 4)
        m.item(t) = .Cells(i, 7)
        f.item(t) = .Cells(i, 8)
Или можно закинуть в одну. Если можно то как вытаскивать нужный элемент из библиотеки.
Заранее спасибо.
Изменено: DSH - 26 Фев 2015 09:16:59
Многоуровневый поиск и вывод результатов, Поиск внутри поиска и вывод результатов
 
Hugo спасибо большое за помощь.

Я тоже смог сделать, в самой таблице ввел дополнительные параметры и по ним уже поиск выполняет. Может он и не грамотен, но тем не менее кому то понадобиться.
Изменено: DSH - 25 Фев 2015 11:20:38
Многоуровневый поиск и вывод результатов, Поиск внутри поиска и вывод результатов
 
Вот пример.
Цитата
Вам именно макрос?
Да, как построить логику чтобы обработать все критерии поиска по всем уровням и вывод соответствующих результатов
Многоуровневый поиск и вывод результатов, Поиск внутри поиска и вывод результатов
 
Доброго времени суток всем. Помогите советом.
Есть лист- 3 колонки: 1-список клиентов (они могут повторятся);2-коды приходов, они могут повторятся только у одного клиента;3-сумма прихода.
Цель: найти нужного клиента, найти все "коды приходов" и по каждому "коду приходов" просуммировать "сумму приходов"  
Код
 iLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
    For i = 4 To iLastRow 
        If .Cells(i, 1) = Klient Then ' находим клиента по запросу 
        kPrih = .Cells(i, 2).Value 'вытаскиваем код прихода
        
        .............
        
        End If
    Next i
Клиента нахожу. Не могу сообразить как дальше строить логику. Получаю первый код, а как искать остальные коды, чтобы еще и по клиенту нужному был.
Заранее спасибо.
Перенос листов в новую книгу, если помечен checkbox
 
Да, это я заметил когда вносил, немного сглупил с кавычками.
Спасибо за наставление.
Перенос листов в новую книгу, если помечен checkbox
 
Hugo- спасибо большое за помощь
Перенос листов в новую книгу, если помечен checkbox
 
Не подскажите а как можно использовать полученный массив имен в качестве названия охраняемого файла.
Код
xp=activeworkbook.path 
'массив перебора имен
Set wb = ActiveWorkbook
wb.SaveAs Filename:=xp & "\" & "Отчеты" & "\" & " список листов " & ".xlsb"
Заранее спасибо
Перенос листов в новую книгу, если помечен checkbox
 
Спасибо за подробное разьяснение.
А вот с массивом никак не пойму
Код
 ReDim arr(1 To col.Count)
    For Each el In col
     i = i + 1
     arr(i) = el
    Next
    Sheets(arr).Copy 
Откуда берем значение el.
Изменено: DSH - 19 Май 2014 14:56:05
Перенос листов в новую книгу, если помечен checkbox
 
Ого. Hugo Спасибо огромнейшее.
Я пробовал реализовать подобное, так как массивы пока незнаю, через проверку условия и присвоения значения.
А в конце делал sheets(array(x,y,z......).copy. Где x,y,z...... это были имена листов, но выскакивала ошибка. И Даже сейчас пробовал делать проверку несколько условий( наличие true и наличие новой книги). А здесь просто и быстро.
У меня к вам просьба, не могли бы вы пояснить:
Код
CreateObject("Scripting.Dictionary"): .comparemode = 1
Это что, что то типа виртуальной библиотеки для временного хранения, верно?
И что означает ...=0&
Заранее спасибо.
Страницы: 1 2 3 След.
Наверх